Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.job
               prosa.classic.model.arrival.basic.task_arrival
               prosa.classic.model.priority.
Require Import prosa.classic.model.schedule.uni.service
               prosa.classic.model.schedule.uni.workload
               prosa.classic.model.schedule.uni.schedule_of_task.
Require Import prosa.classic.model.schedule.uni.limited.busy_interval
               prosa.classic.model.schedule.uni.limited.abstract_RTA.definitions
               prosa.classic.model.schedule.uni.limited.abstract_RTA.abstract_seq_rta.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq path fintype bigop.

(** * JLFP instantiation of Interference and Interfering Workload *)
(** In this module we instantiate functions Interference and Interfering Workload
    for an arbitrary JLFP-policy that satisfies the sequential jobs hypothesis.
    We also prove equivalence of Interference and Interfering Workload to the
    more conventional notions of service or workload. *)
Module JLFPInstantiation.

  Import Job TaskArrival ScheduleOfTask Priority Workload Service BusyIntervalJLFP.

  Section Instantiation.

    Context {Task: eqType}.
    Variable task_cost: Task -> time.

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

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

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

    (* Assume we have sequential jobs, i.e., jobs from the
       same task execute in the order of their arrival. *)
    Hypothesis H_sequential_jobs: sequential_jobs job_arrival job_cost sched job_task.

    (* Consider a JLFP-policy that indicates a higher-or-equal priority relation,
       and assume that this relation is reflexive and transitive. *)
    Variable higher_eq_priority: JLFP_policy Job.
    Hypothesis H_priority_is_reflexive: JLFP_is_reflexive higher_eq_priority.
    Hypothesis H_priority_is_transitive: JLFP_is_transitive higher_eq_priority.

    (* We also assume that the policy respects sequential jobs, meaning
       that later-arrived jobs of a task don't have higher priority than
       earlier-arrived jobs of the same task. *)
    Hypothesis H_JLFP_respects_sequential_jobs:
      JLFP_respects_sequential_jobs
        job_task job_arrival higher_eq_priority.

    (* Let tsk be any task in ts that is to be analyzed. *)
    Variable tsk: Task.

    (* For simplicity, let's define some local names. *)
    Let job_scheduled_at := scheduled_at sched.
    Let job_completed_by := completed_by job_cost sched.
    Let arrivals_between := jobs_arrived_between arr_seq.
    Let quiet_time := quiet_time job_arrival job_cost arr_seq sched higher_eq_priority.
    Let cumulative_task_interference :=
      AbstractSeqRTA.cumul_task_interference job_task arr_seq sched.

    (** ** Interference and Interfering Workload *)
    (** In this section, we introduce definitions of interference,
        interfering workload and a function that bounds cumulative interference. *)

    (* For proper calculation of interference and interfering workload of a job, we need to distinguish
       interference received from other jobs of the same task and other jobs of other tasks. In that
       regard, we introduce two additional relations. The first relation defines whether job j1 has a
       higher-than-or-equal-priority than job j2 and j1 is not equal to j2... *)
    Let another_job_with_higher_eq_priority: JLFP_policy Job :=
      fun j1 j2 => higher_eq_priority j1 j2 && (j1 != j2).

    (* ...and the second relation defines whether a job j1 has a higher-or-equal-priority than
       job j2 and the task of j1 is not equal to task of j2. *)
    Let job_from_another_task_with_higher_eq_priority: JLFP_policy Job :=
      fun j1 j2 => higher_eq_priority j1 j2 && (job_task j1 != job_task j2).

    (* In order to introduce the interference, first we need to recall the definition
       of priority inversion introduced in module limited.fixed_priority.busy_interval:
         [ Definition is_priority_inversion t := ]
         [   if sched t is Some jlp then         ]
         [     ~~ higher_eq_priority jlp j       ]
         [   else false.                         ]
       I.e., we say that job j is incurring a priority inversion at time t
       if there exists a job with lower priority that executes at time t.
       In order to simplify things, we ignore the fact that according to this
       definition a job can incur priority inversion even before its release
       (or after completion). All such (potentially bad) cases do not cause
       problems, as each job is analyzed only within the corresponding busy
       interval where the priority inversion behaves in the expected way. *)
    Let is_priority_inversion (j: Job) (t: time) :=
      is_priority_inversion sched higher_eq_priority j t.

    (* Next, we say that job j is incurring interference from another job with higher or equal
       priority at time t, if there exists job jhp (different from j) with a higher or equal priority
       that executes at time t. *)
    Definition is_interference_from_another_job_with_higher_eq_priority (j: Job) (t: time) :=
      if sched t is Some jhp then
        another_job_with_higher_eq_priority jhp j
      else false.

    (* Similarly, we say that job j is incurring interference from a job with higher or
       equal priority of another task at time t, if there exists a job jhp (of a different task)
       with higher or equal priority that executes at time t. *)
    Definition is_interference_from_another_task_with_higher_eq_priority (j: Job) (t: time) :=
      if sched t is Some jhp then
        job_from_another_task_with_higher_eq_priority jhp j
      else false.

    (* Now, we define the notion of cumulative interference, called
       interfering_workload_of_jobs_with_hep_priority, that says
       how many units of workload are generated by jobs with higher
       or equal priority released at time t. *)
    Definition interfering_workload_of_jobs_with_hep_priority (j: Job) (t: time) :=
      \sum_(jhp <- jobs_arriving_at arr_seq t |
            another_job_with_higher_eq_priority jhp j) job_cost jhp.

    (* Instantiation of Interference *)
    (* We say that job j incurs interference at time t iff it cannot execute due to
       a higher-or-equal-priority job being scheduled, or if it incurs a priority inversion. *)
    Definition interference j t :=
      is_priority_inversion j t || is_interference_from_another_job_with_higher_eq_priority j t.

    (* Instantiation of Interfering Workload *)
    (* The interfering workload, in turn, is defined as the sum of the priority inversion
       function and interfering workload of jobs with higher or equal priority. *)
    Definition interfering_workload j t :=
      is_priority_inversion j t + interfering_workload_of_jobs_with_hep_priority j t.

    (* For each of the concepts defined above, we introduce a corresponding cumulative function: *)
    (* (a) cumulative priority inversion... *)
    Let cumulative_priority_inversion j t1 t2 :=
      \sum_(t1 <= t < t2) is_priority_inversion j t.

    (* ... (b) cumulative interference from other jobs with higher or equal priority... *)
    Let cumulative_interference_from_other_jobs j t1 t2 :=
      \sum_(t1 <= t < t2) is_interference_from_another_job_with_higher_eq_priority j t.

    (* ... (c) and cumulative interference from jobs with higher or equal priority from other tasks... *)
    Let cumulative_interference_from_other_tasks j t1 t2 :=
      \sum_(t1 <= t < t2) is_interference_from_another_task_with_higher_eq_priority j t.

    (* ... (d) cumulative interference... *)
    Let cumulative_interference j t1 t2 := \sum_(t1 <= t < t2) interference j t.

    (* ... (e) cumulative workload from jobs with higher or equal priority... *)
    Let cumulative_interfering_workload_of_jobs_with_hep_priority j t1 t2 :=
      \sum_(t1 <= t < t2) interfering_workload_of_jobs_with_hep_priority j t.

    (* ... (f) and cumulative interfering workload. *)
    Let cumulative_interfering_workload j t1 t2 := \sum_(t1 <= t < t2) interfering_workload j t.

    (* Instantiated functions usually do not have any useful lemmas about them. In order to
       reuse existing lemmas, we need to prove equivalence of the instantiated functions to
       some conventional notions. The instantiations given in this file are equivalent to
       service and workload. Further, we prove these equivalences formally. *)

    (* Before we present the formal proofs of the equivalences, we recall
       the notion of workload of higher or equal priority jobs. *)
    Let workload_of_other_jobs_with_hep_priority j t1 t2 :=
      workload_of_jobs job_cost (arrivals_between t1 t2)
                       (fun jhp => another_job_with_higher_eq_priority jhp j).

    (* Similarly, we recall notions of service of higher or equal priority jobs from other tasks... *)
    Let service_of_jobs_from_other_tasks_with_hep_priority j t1 t2 :=
      service_of_jobs sched (arrivals_between t1 t2)
                      (fun jhp => job_from_another_task_with_higher_eq_priority jhp j) t1 t2.

    (* ... and service of all other jobs with higher or equal priority. *)
    Let service_of_other_jobs_with_hep_priority j t1 t2 :=
      service_of_jobs sched (arrivals_between t1 t2)
                      (fun jhp => another_job_with_higher_eq_priority jhp j) t1 t2.

    (** ** Equivalences *)
    (** In this section we prove a few equivalences between the definitions obtained by
        instantiation of definitions from the Abstract RTA module (interference and
        interfering workload) and definitions corresponding to the conventional concepts.

        As it was mentioned previously, instantiated functions of interference and
        interfering workload usually do not have any useful lemmas about them. Hovewer,
        it is possible to prove their equivalence to the more conventional notions like
        service or workload. Next we prove the equivalence between the instantiations
        and conventional notions. *)
    Section Equivalences.

      (* We prove that we can split cumulative interference into two parts: (1) cumulative priority
         inversion and (2) cumulative interference from jobs with higher or equal priority. *)
      Lemma cumulative_interference_split:
        forall j t1 t2,
          cumulative_interference j t1 t2
          = cumulative_priority_inversion j t1 t2 + cumulative_interference_from_other_jobs j t1 t2.
        rewrite /cumulative_interference /cumulative_priority_inversion
                /cumulative_interference_from_other_jobs /interference.
        intros; rewrite -big_split //=.
        apply/eqP; rewrite eqn_leq; apply/andP; split; rewrite leq_sum; try done.
        { intros t _; unfold is_priority_inversion,
                      BusyIntervalJLFP.is_priority_inversion,
                      is_interference_from_another_job_with_higher_eq_priority.
          case SCHED: (sched t) => [s | ]; last by done.
            by case HP: (higher_eq_priority s j); simpl; rewrite ?addn0 ?add0n.
        }
        { intros t _; unfold is_priority_inversion,
                      BusyIntervalJLFP.is_priority_inversion,
                      is_interference_from_another_job_with_higher_eq_priority.
          case SCHED: (sched t) => [s | ]; last by done.
          unfold another_job_with_higher_eq_priority.
            by case HP: (higher_eq_priority s j); simpl; rewrite ?addn0 ?add0n.
        }
      Qed.

      (* Let j be any job of task tsk, and let upp_t be any time instant after job j's arrival.
         Then for any time interval lying before upp_t, the cumulative interference received by tsk
         is equal to the sum of the cumulative priority inversion of job j and the cumulative interference
         incurred by task tsk due to other tasks. *)
      Lemma cumulative_task_interference_split:
        forall j t1 t2 upp_t,
          job_task j = tsk ->
          j \in jobs_arrived_before arr_seq upp_t ->
          ~~ job_completed_by j t2 ->
          cumulative_task_interference interference tsk upp_t t1 t2 =
          cumulative_priority_inversion j t1 t2 +
          cumulative_interference_from_other_tasks j t1 t2.
      Proof.
        rewrite /cumulative_task_interference /AbstractSeqRTA.cumul_task_interference
                /ScheduleOfTask.task_scheduled_at
                /cumulative_priority_inversion
                /cumulative_interference_from_other_tasks.
        intros j t1 R upp TSK ARR NCOMPL.
        rewrite -big_split //=.
        rewrite big_nat_cond [X in _ = X]big_nat_cond.
        apply/eqP; rewrite eqn_leq; apply/andP; split.
        { apply leq_sum; intros t _.
          rewrite /interference /is_priority_inversion /BusyIntervalJLFP.is_priority_inversion
                  /is_interference_from_another_task_with_higher_eq_priority
                  /is_interference_from_another_job_with_higher_eq_priority
                  /AbstractSeqRTA.task_interference_received_before
                  /another_job_with_higher_eq_priority /job_from_another_task_with_higher_eq_priority
                  /ScheduleOfTask.task_scheduled_at.
          case SCHED: (sched t) => [s | ]; last by rewrite has_pred0 addn0 leqn0 eqb0.
          case HP: (higher_eq_priority s j); simpl; last by rewrite addn0 leq_b1.
          rewrite add0n TSK.
          case: ((job_task s != tsk)); last by done.
            by rewrite Bool.andb_true_l leq_b1.
        }
        { apply leq_sum; move => t /andP [/andP [_ LT'] _].
          rewrite /is_priority_inversion /BusyIntervalJLFP.is_priority_inversion
                  /is_interference_from_another_task_with_higher_eq_priority
                  /is_interference_from_another_job_with_higher_eq_priority /another_job_with_higher_eq_priority
                  /job_from_another_task_with_higher_eq_priority /AbstractSeqRTA.task_interference_received_before
                  /ScheduleOfTask.task_scheduled_at .
          case SCHED: (sched t) => [s | ]; last by done.
          rewrite -TSK; case TSKEQ: (job_task s == job_task j); simpl.
          { rewrite Bool.andb_false_r leqn0 addn0 eqb0.
            apply/negP; intros NEQ.
            move: SCHED => /eqP SCHED.
            move: NCOMPL => /negP NCOMPL; apply: NCOMPL.
            apply completion_monotonic with t; [ by apply ltnW | ].
            apply/negP; intros NCOMPL; move: NCOMPL => /negP NCOMPL.
            have ARRle := (scheduler_executes_job_with_earliest_arrival
                             job_arrival _ _ _ _  s j t TSKEQ NCOMPL SCHED).
            feed ARRle; try done.
            move: NEQ => /negP NEQ; apply: NEQ.
              by apply H_JLFP_respects_sequential_jobs.
          }
          have NEQ: s != j.
          { apply/negP; intros EQ; move: EQ => /eqP EQ.
            move: TSKEQ => /eqP TSKEQ; apply: TSKEQ.
              by rewrite EQ.
          }
          have Fact: forall b, ~~ b + b = true; first by intros b; destruct b.
          rewrite Bool.andb_true_r Fact; simpl; rewrite lt0b; clear Fact.
          apply/hasP; exists j.
          { rewrite /arrivals_of_task_before /arrivals_of_task_between.
            rewrite /arrivals_of_task_between mem_filter; apply/andP; split; first by rewrite /is_job_of_task.
              by unfold jobs_arrived_before in ARR; apply jobs_arrived_between_sub with (t2 := 0) (t3 := upp).
          }
          { case HP: (higher_eq_priority s j).
            { apply/orP; right.
              rewrite /is_interference_from_another_job_with_higher_eq_priority SCHED.
                by rewrite /another_job_with_higher_eq_priority NEQ Bool.andb_true_r. }
            { apply/orP; left.
                by rewrite /is_priority_inversion /BusyIntervalJLFP.is_priority_inversion SCHED HP.
            }
          }
        }
      Qed.

      (* In this section we prove that the (abstract) cumulative interfering workload is equivalent to
         conventional workload, i.e., the one defined with concrete schedule parameters. *)
      Section InstantiatedWorkloadEquivalence.

        (* Let [t1,t2) be any time interval. *)
        Variables t1 t2: time.

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

        (* Then for any job j, the cumulative interfering workload is equal to the conventional workload. *)
        Lemma instantiated_cumulative_workload_of_hep_jobs_equal_total_workload_of_hep_jobs:
          cumulative_interfering_workload_of_jobs_with_hep_priority j t1 t2
          = workload_of_other_jobs_with_hep_priority j t1 t2.
        Proof.
          intros.
          unfold cumulative_interfering_workload_of_jobs_with_hep_priority, workload_of_other_jobs_with_hep_priority.
          case NEQ: (t1 < t2); last first.
          { move: NEQ => /negP /negP; rewrite -leqNgt; move => NEQ.
            rewrite big_geq; last by done.
            rewrite /arrivals_between /jobs_arrived_between big_geq; last by done.
              by rewrite /workload_of_jobs big_nil.
          }
          { unfold interfering_workload_of_jobs_with_hep_priority, workload_of_jobs.
            have EX: exists k, t2 = t1 + k.
            { exists (t2 - t1). rewrite subnKC. by done.  by rewrite ltnW.  }
            move: EX => [k EQ]. subst t2. clear NEQ.
            induction k.
            - rewrite !addn0.
              rewrite big_geq; last by done.
              rewrite /arrivals_between /jobs_arrived_between big_geq; last by done.
                by rewrite /workload_of_jobs big_nil.
            - rewrite addnS big_nat_recr //=; last by rewrite leq_addr.
              rewrite IHk.
              rewrite /arrivals_between /jobs_arrived_between big_nat_recr //=; last by rewrite leq_addr.
                by rewrite big_cat //=.
          }
        Qed.

      End InstantiatedWorkloadEquivalence.

      (* In this section we prove that the (abstract) cumulative interference of jobs with higher or
         equal priority is equal to total service of jobs with higher or equal priority. *)
      Section InstantiatedServiceEquivalences.

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

        (* We consider an arbitrary time interval [t1, t) that starts with a quiet time. *)
        Variable t1 t: time.
        Hypothesis H_quiet_time: quiet_time j t1.

        (* Then for any job j, the (abstract) instantiated function of interference is
           equal to the total service of jobs with higher or equal priority. *)
        Lemma instantiated_cumulative_interference_of_hep_jobs_equal_total_interference_of_hep_jobs:
          cumulative_interference_from_other_jobs j t1 t = service_of_other_jobs_with_hep_priority j t1 t.
        Proof.
          { rewrite /cumulative_interference_from_other_jobs /is_interference_from_another_job_with_higher_eq_priority
                    /service_of_other_jobs_with_hep_priority.
            case NEQ: (t1 <= t); last first.
            { apply negbT in NEQ; rewrite -ltnNge in NEQ.
              rewrite big_geq; last by apply ltnW.
              rewrite /service_of_jobs /arrivals_between /jobs_arrived_between big_geq; last by apply ltnW.
                by rewrite big_nil.
            }
            have EX: exists k, t = t1 + k.
            { by exists (t - t1); rewrite subnKC. } move: EX => [k EQ]. subst t. clear NEQ.
            induction k.
            - rewrite addn0 big_geq; last by done.
                by rewrite /arrivals_between /jobs_arrived_between big_geq // /service_of_jobs big_nil.
            - unfold service_of_jobs, service_during.
              unfold is_interference_from_another_job_with_higher_eq_priority.
              rewrite addnS.
              rewrite big_nat_recr //=.
              unfold arrivals_between, jobs_arrived_between.
              rewrite big_nat_recr //=.
              rewrite big_cat //=.
              rewrite IHk.
              have EQ:
                \sum_(i0 <- jobs_arriving_at arr_seq (t1 + k) | higher_eq_priority i0 j && (i0 != j))
                 \sum_(t1 <= t0 < (t1 + k).+1) service_at sched i0 t0
                =
                \sum_(i0 <- jobs_arriving_at arr_seq (t1 + k) | higher_eq_priority i0 j && (i0 != j))
                 \sum_(t1 + k <= t0 < (t1 + k).+1) service_at sched i0 t0.
              {
                rewrite big_seq_cond [X in _ = X]big_seq_cond.
                apply/eqP; rewrite eqn_leq; apply/andP; split.
                {
                  rewrite leq_sum //.
                  move => jo /andP [ARR /andP [HP NTSK]].
                  rewrite (@big_cat_nat _ _ _ (t1 + k)) //=.
                  rewrite -[X in _ <= X]add0n leq_add //.
                  rewrite leqn0.
                  rewrite big_nat_cond.
                  rewrite big1 //.
                  move => x /andP [/andP [_ LT] _].
                  apply/eqP; rewrite eqb0; apply/negP; intros NSCHED.
                  unfold jobs_must_arrive_to_execute, arrival_times_are_consistent in *.
                  apply H_jobs_must_arrive_to_execute in NSCHED.
                  unfold has_arrived in NSCHED.
                  apply H_arrival_times_are_consistent in ARR.
                  rewrite -ARR in LT.
                    by move: LT; rewrite ltnNge; move => /negP LT.
                      by rewrite leq_addr.
                }
                {
                  rewrite leq_sum //.
                  move => jo /andP [ARR /andP [HP NTSK]].
                  rewrite [X in _ <= X](@big_cat_nat _ _ _ (t1 + k )) //=. rewrite leq_addl //.
                    by rewrite leq_addr.
                }
              }
              rewrite EQ.
              apply/eqP.
              rewrite exchange_big //=.
              rewrite (@big_cat_nat _ _ _ (t1 + k)) //=.
              rewrite exchange_big //=.
              rewrite  big_nat1.
              rewrite -addnA.
              rewrite eqn_add2l.
              rewrite exchange_big //=.
              rewrite big_nat1.
              rewrite -big_cat //=. rewrite -big_nat_recr //=.
              clear EQ IHk.
              case SCHED: (sched (t1 + k)) => [jo | ].
              case PRIO: (another_job_with_higher_eq_priority jo j).
              { simpl.
                rewrite eqn_leq; apply/andP; split; last by apply service_of_jobs_le_1 with job_arrival.
                rewrite (big_rem jo) //=.
                rewrite PRIO  /service_at /scheduled_at SCHED eq_refl add1n; by done.
                apply arrived_between_implies_in_arrivals with (job_arrival0 := job_arrival); try done.
                unfold jobs_come_from_arrival_sequence in *.
                apply H_jobs_come_from_arrival_sequence with (t1 + k). by rewrite /scheduled_at SCHED.
                { move: PRIO => /andP [PRIO1 PRIO2].
                  rewrite /arrived_between ltnS; apply/andP; split.
                  { rewrite leqNgt; apply/negP; intros AB.
                    move: (SCHED) => /eqP /negP SCHED2; apply: SCHED2.
                    apply/negP.
                    apply completed_implies_not_scheduled with job_cost; try done.
                    apply completion_monotonic with t1; try done.
                    rewrite leq_addr; by done.
                    apply H_quiet_time; try done.
                    move: SCHED => /eqP SCHED.
                      by apply H_jobs_come_from_arrival_sequence  in SCHED.
                  }
                  {
                    move: SCHED => /eqP SCHED.
                      by apply H_jobs_must_arrive_to_execute in SCHED.
                  }
                }
              }
              {
                simpl.
                rewrite eq_sym big1 //.
                intros joo PRIO2.
                apply/eqP; rewrite eqb0; apply/negP; intros SCHED2.
                move: SCHED2 => /eqP SCHED2.
                rewrite SCHED2 in SCHED.
                inversion SCHED; subst joo.
                  by rewrite PRIO in PRIO2.
              }
              { simpl.
                rewrite eq_sym big1 //.
                intros.
                  by rewrite /service_at /scheduled_at SCHED.
              }
                by rewrite leq_addr.
                by rewrite leq_addr .
                  by rewrite leq_addr.
                    by rewrite leq_addr.
          }
        Qed.

        (* The same applies to the alternative definition of interference. *)
        Lemma instantiated_cumulative_interference_of_hep_tasks_equal_total_interference_of_hep_tasks:
          cumulative_interference_from_other_tasks j t1 t = service_of_jobs_from_other_tasks_with_hep_priority j t1 t.
        Proof.
          rewrite /cumulative_interference_from_other_tasks /service_of_jobs_from_other_tasks_with_hep_priority
                  /job_from_another_task_with_higher_eq_priority.
          case NEQ: (t1 <= t); last first.
          { apply negbT in NEQ; rewrite -ltnNge in NEQ.
            rewrite big_geq; last by apply ltnW.
            rewrite /service_of_jobs /arrivals_between /jobs_arrived_between big_geq; last by apply ltnW.
              by rewrite big_nil.
          }
          { have EX: exists k, t = t1 + k; first by exists (t - t1); rewrite subnKC.
                                                 move: EX => [k EQ]; subst t; clear NEQ.
                                                 induction k.
                                                 - rewrite addn0 big_geq; last by done.
                                                     by rewrite /arrivals_between /jobs_arrived_between big_geq // /service_of_jobs big_nil.
                                                 - unfold service_of_jobs, service_during.
                                                   unfold is_interference_from_another_job_with_higher_eq_priority.
                                                   rewrite addnS.
                                                   rewrite big_nat_recr //=.
                                                   unfold arrivals_between, jobs_arrived_between.
                                                   rewrite big_nat_recr //=.
                                                   rewrite big_cat //=.
                                                   rewrite IHk.
                                                   have EQ:
                                                     \sum_(i0 <- jobs_arriving_at arr_seq (t1 + k) | higher_eq_priority i0 j &&
                                                                                (job_task i0 != job_task j))
                                                      \sum_(t1 <= t0 < (t1 + k).+1) service_at sched i0 t0
                                                     =
                                                     \sum_(i0 <- jobs_arriving_at arr_seq (t1 + k) | higher_eq_priority i0 j &&
                                                                                (job_task i0 != job_task j))
                                                      \sum_(t1 + k <= t0 < (t1 + k).+1) service_at sched i0 t0.
                                                   {
                                                     rewrite big_seq_cond [X in _ = X]big_seq_cond.
                                                     apply/eqP; rewrite eqn_leq; apply/andP; split.
                                                     {
                                                       rewrite leq_sum //.
                                                       move => jo /andP [ARR /andP [HP NTSK]].
                                                       rewrite (@big_cat_nat _ _ _ (t1 + k)) //=.
                                                       rewrite -[X in _ <= X]add0n leq_add //.
                                                       rewrite leqn0.
                                                       rewrite big_nat_cond.
                                                       rewrite big1 //.
                                                       move => x /andP [/andP [_ LT] _].
                                                       apply/eqP; rewrite eqb0; apply/negP; intros NSCHED.
                                                       unfold jobs_must_arrive_to_execute, arrival_times_are_consistent in *.
                                                       apply H_jobs_must_arrive_to_execute in NSCHED.
                                                       unfold has_arrived in NSCHED.
                                                       apply H_arrival_times_are_consistent in ARR.
                                                       rewrite -ARR in LT.
                                                         by move: LT; rewrite ltnNge; move => /negP LT.
                                                           by rewrite leq_addr.
                                                     }
                                                     {
                                                       rewrite leq_sum //.
                                                       move => jo /andP [ARR /andP [HP NTSK]].
                                                       rewrite [X in _ <= X](@big_cat_nat _ _ _ (t1 + k )) //=. rewrite leq_addl //.
                                                         by rewrite leq_addr.
                                                     }
                                                   }
                                                   rewrite EQ.
                                                   apply/eqP.
                                                   rewrite exchange_big //=.
                                                   rewrite (@big_cat_nat _ _ _ (t1 + k)) //=.
                                                   rewrite exchange_big //=.
                                                   rewrite  big_nat1.
                                                   rewrite -addnA.
                                                   rewrite eqn_add2l.
                                                   rewrite exchange_big //=.
                                                   rewrite big_nat1.
                                                   rewrite -big_cat //=. rewrite -big_nat_recr //=.
                                                   clear EQ IHk.
                                                   case SCHED: (sched (t1 + k)) => [jo | ].
                                                   unfold is_interference_from_another_task_with_higher_eq_priority.
                                                   case PRIO: (job_from_another_task_with_higher_eq_priority jo j).
                                                   { simpl.
                                                     rewrite eqn_leq; apply/andP; split.
                                                     { rewrite (big_rem jo) //=.
                                                       unfold job_from_another_task_with_higher_eq_priority in PRIO.
                                                       rewrite PRIO /job_from_another_task_with_higher_eq_priority
                                                               /is_interference_from_another_task_with_higher_eq_priority /service_at
                                                               /scheduled_at SCHED eq_refl add1n PRIO; by done.
                                                       apply arrived_between_implies_in_arrivals with (job_arrival0 := job_arrival); try done.
                                                       unfold jobs_come_from_arrival_sequence in *.
                                                       apply H_jobs_come_from_arrival_sequence with (t1 + k). by rewrite /scheduled_at SCHED.
                                                       { move: PRIO => /andP [PRIO1 PRIO2].
                                                         rewrite /arrived_between ltnS; apply/andP; split.
                                                         { rewrite leqNgt; apply/negP; intros AB.
                                                           move: (SCHED) => /eqP /negP SCHED2; apply: SCHED2.
                                                           apply/negP.
                                                           apply completed_implies_not_scheduled with job_cost; try done.
                                                           apply completion_monotonic with t1; try done.
                                                           rewrite leq_addr; by done.
                                                           apply H_quiet_time; try done.
                                                           move: SCHED => /eqP SCHED.
                                                             by apply H_jobs_come_from_arrival_sequence  in SCHED.
                                                         }
                                                         {
                                                           move: SCHED => /eqP SCHED.
                                                             by apply H_jobs_must_arrive_to_execute in SCHED.
                                                         }
                                                       }
                                                     }
                                                     {
                                                       rewrite SCHED PRIO.
                                                         by apply service_of_jobs_le_1 with job_arrival.
                                                     }
                                                   }
                                                   {
                                                     simpl. rewrite SCHED.
                                                     rewrite eq_sym big1. rewrite PRIO //.
                                                     intros joo PRIO2.
                                                     apply/eqP; rewrite eqb0; apply/negP; intros SCHED2.
                                                     move: SCHED2 => /eqP SCHED2.
                                                     rewrite SCHED2 in SCHED.
                                                     inversion SCHED; subst joo.
                                                     unfold job_from_another_task_with_higher_eq_priority in PRIO.
                                                       by rewrite PRIO in PRIO2.
                                                   }
                                                   { simpl.
                                                     rewrite /is_interference_from_another_task_with_higher_eq_priority eq_sym big1 //.
                                                     rewrite SCHED; by done.
                                                     intros.
                                                       by rewrite /service_at /scheduled_at SCHED.
                                                   }
                                                     by rewrite leq_addr.
                                                     by rewrite leq_addr .
                                                       by rewrite leq_addr.
                                                         by rewrite leq_addr.
          }
        Qed.

      End InstantiatedServiceEquivalences.

      (* In this section we prove that the abstract definition of busy interval is equivalent to
         the conventional, concrete definition of busy interval for JLFP scheduling. *)
      Section BusyIntervalEquivalence.

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

        (* We prove that the concept of quiet time obtained by instantiating the abstract
           definition of quiet time coincides with the conventional definition of quiet time
           (which is defined in module limited.busy_interval). *)
        Lemma instantiated_quiet_time_equivalent_edf_quiet_time:
          forall t,
            quiet_time j t <->
            AbstractRTADefinitions.quiet_time job_arrival job_cost sched interference interfering_workload j t.
        Proof.
          have zero_is_quiet_time: forall j, quiet_time j 0.
          { by intros jhp ARR HP AB; move: AB; rewrite /arrived_before ltn0. }
          have CIS := cumulative_interference_split.
          have IC1 := instantiated_cumulative_interference_of_hep_jobs_equal_total_interference_of_hep_jobs.
          have IC2 := instantiated_cumulative_interference_of_hep_tasks_equal_total_interference_of_hep_tasks.
          rewrite /cumulative_interference
                  /cumulative_interference_from_other_jobs
                  /interference /interfering_workload /cumulative_interference_from_other_tasks
                  /service_of_jobs_from_other_tasks_with_hep_priority
                  /service_of_other_jobs_with_hep_priority /job_from_another_task_with_higher_eq_priority
            in CIS, IC1, IC2.
          intros t; split; intros.
          { unfold AbstractRTADefinitions.quiet_time; split.
            { rewrite /cumulative_interference /AbstractRTADefinitions.cumul_interference
                      /AbstractRTADefinitions.cumul_interfering_workload
                      /cumulative_interference_from_other_jobs
                      /interference /interfering_workload.
              rewrite CIS !big_split //=.
              apply/eqP; rewrite eqn_add2l.
              have L11 := all_jobs_have_completed_equiv_workload_eq_service.
              rewrite IC1; last by apply zero_is_quiet_time.
              have L2 := instantiated_cumulative_workload_of_hep_jobs_equal_total_workload_of_hep_jobs;
                           rewrite /cumulative_interfering_workload_of_jobs_with_hep_priority in L2.
              rewrite L2.
              rewrite eq_sym; apply/eqP.
              apply L11 with job_arrival; try done.
              intros.
              apply H; try done.
              apply in_arrivals_implies_arrived in H0; by done.
              move: H1 => /andP [H3 H4].
              unfold FP_to_JLFP.  by done.
              apply in_arrivals_implies_arrived_between with (job_arrival0 := job_arrival) in H0; try done.
            }
            {
              unfold pending_earlier_and_at.
              rewrite negb_and Bool.negb_involutive; apply/orP.
              case ARR: (arrived_before job_arrival j t); [right | by left].
                by apply H.
            }
          }
          {
            intros jhp ARR HP ARB.
            eapply all_jobs_have_completed_equiv_workload_eq_service with
                (P :=  (fun jhp => higher_eq_priority jhp j)) (t1 := 0)(t2 := t); eauto 2; last first.
            eapply arrived_between_implies_in_arrivals; eauto 2.
            move: H => [H0 H1].
            move: H0.
            rewrite /AbstractRTADefinitions.cumul_interference /AbstractRTADefinitions.cumul_interfering_workload
                    /interference /interfering_workload.
            rewrite CIS !big_split //=; move => /eqP; rewrite eqn_add2l.
            rewrite IC1; last by apply zero_is_quiet_time.
            have L2 := instantiated_cumulative_workload_of_hep_jobs_equal_total_workload_of_hep_jobs;
                         rewrite /cumulative_interfering_workload_of_jobs_with_hep_priority in L2.
            rewrite L2. move => H2.
            have H2EQ:
              service_of_jobs sched (arrivals_between 0 t)
                              (fun jhp : Job =>
                                 higher_eq_priority jhp j) 0 t ==
              workload_of_jobs job_cost (arrivals_between 0 t)
                               (fun jhp : Job =>
                                  higher_eq_priority jhp j).
            { move: H1; rewrite negb_and Bool.negb_involutive -leqNgt; move => /orP [H1 | H1].
              { intros.
                have NOTIN: j \notin arrivals_between 0 t.
                { apply/memPn.
                  intros jo IN; apply/negP; intros EQ; move: EQ => /eqP EQ.
                  subst jo.
                  unfold arrivals_between in *.
                  apply in_arrivals_implies_arrived_between with (job_arrival0:= job_arrival) in IN; try done.
                    by move: IN => /andP [_ IN]; move: H1; rewrite leqNgt; move => /negP LT; apply: LT.
                }
                have UL1 := sum_notin_rem_eqn.
                rewrite /workload_of_other_jobs_with_hep_priority
                        /another_job_with_higher_eq_priority in H2.
                  by rewrite /service_of_jobs /workload_of_jobs !sum_notin_rem_eqn in H2.
              }
              {
                have JIN: j \in arrivals_between 0 t.
                { eapply completed_implies_scheduled_before in H1; eauto 2.
                  apply arrived_between_implies_in_arrivals with (job_arrival0:= job_arrival); try done.
                  move: H1 => [t' [H3 _]].
                  apply/andP; split; first by done.
                  move: H3 => /andP [H3e H3t].
                    by apply leq_ltn_trans with t'.
                }
                have UNIC: uniq (arrivals_between 0 t).
                { by eapply arrivals_uniq; eauto 2. }
                unfold service_of_jobs, workload_of_jobs in H2.
                unfold service_of_jobs, workload_of_jobs.
                rewrite big_mkcond //=.
                rewrite (bigD1_seq j) //=.
                rewrite -big_mkcondl //=.
                move: H2 => /eqP H2. rewrite H2.
                rewrite [X in _ == X]big_mkcond //=.
                rewrite [X in _ == X](bigD1_seq j) //=.
                rewrite -big_mkcondl //=.
                rewrite eqn_add2r H_priority_is_reflexive.
                  by rewrite eqn_leq; apply/andP; split; try eauto 2.
              }
            }
              by move: H2EQ => /eqP H2EQ.
          }
        Qed.

        (* Based on that, we prove that the concept of busy interval obtained by instantiating the abstract
           definition of busy interval coincides with the conventional definition of busy interval. *)
        Lemma instantiated_busy_interval_equivalent_edf_busy_interval:
          forall t1 t2,
            busy_interval job_arrival job_cost arr_seq sched higher_eq_priority j t1 t2 <->
            AbstractRTADefinitions.busy_interval job_arrival job_cost sched interference interfering_workload j t1 t2.
        Proof.
          split.
          {
            move => [[NEQ [QTt1 [NQT REL]] QTt2]].
            - split; last by eapply instantiated_quiet_time_equivalent_edf_quiet_time in QTt2; eauto 2.
            - split; first by done.
            - split; first by apply instantiated_quiet_time_equivalent_edf_quiet_time in QTt1; eauto 2.
                by intros t NEQ' QT; eapply NQT; eauto 2; apply instantiated_quiet_time_equivalent_edf_quiet_time.
          }
          { move => [[/andP [NEQ1 NEQ2] [QTt1 NQT] QTt2]].
            - split; last by eapply instantiated_quiet_time_equivalent_edf_quiet_time; eauto 2.
            - split; first by apply leq_ltn_trans with (job_arrival j).
            - split; first by eapply instantiated_quiet_time_equivalent_edf_quiet_time; eauto 2.
            - split; first by intros t NEQ QT; eapply NQT; eauto 2; eapply instantiated_quiet_time_equivalent_edf_quiet_time in QT; eauto 2.
            - by apply/andP; split.
          }
        Qed.

      End BusyIntervalEquivalence.

    End Equivalences.

  End Instantiation.

End JLFPInstantiation.


Load LFindLoad.
From lfind Require Import LFind.
From adtind Require Import goal34.

Set Printing Depth 1000.
Definition lfind_eval  x:=
Succ x.

Compute lfind_eval  (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Zero).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Succ (Succ (Succ (Succ Zero)))).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Zero).


Require Import aes.spec_encryption_LL.
Require Import aes.spec_AES256_HL.
Require Import aes.tablesLL.
Require Import aes.GF_ops_LL.
Require Import aes.conv_HL_to_LL.
Require Import aes.bitfiddling.
Require Import aes.list_lemmas.
Require Import aes.equiv_GF_ops.
Require Import List. Import ListNotations.

Lemma split_quad_eq: forall {T : Type} (c0 c1 c2 c3 c0' c1' c2' c3' : T),
  c0 = c0' -> c1 = c1' -> c2 = c2' -> c3 = c3' -> (c0, c1, c2, c3) = (c0', c1', c2', c3').
Proof.
  intros. congruence.
Qed.

Lemma split_4eq: forall (T : Type) (c0 c1 c2 c3 c0' c1' c2' c3' : T),
  (c0, c1, c2, c3) = (c0', c1', c2', c3') ->
  c0 = c0' /\ c1 = c1' /\ c2 = c2' /\ c3 = c3'.
Proof.
  intros. inversion H. subst. auto.
Qed.

Lemma get_uint32_le_sublist: forall i l,
  0 <= i <= Zlength l - 4 ->
  get_uint32_le l i = get_uint32_le (sublist i (i+4) l) 0.
Proof.
  intros. unfold get_uint32_le.
  do 4 rewrite Znth_sublist by omega.
  replace (0 + i) with i by omega.
  replace (0 + 1 + i) with (i + 1) by omega.
  replace (0 + 2 + i) with (i + 2) by omega.
  replace (0 + 3 + i) with (i + 3) by omega.
  reflexivity.
Qed.

Lemma get_uint32_le_word_to_int: forall b0 b1 b2 b3,
  get_uint32_le (map Int.unsigned [b0; b1; b2; b3]) 0 = word_to_int (b0, b1, b2, b3).
Proof.
  intros. unfold get_uint32_le. unfold word_to_int.
  do 4 rewrite Znth_map with (d' := Int.zero) by (change (Zlength [b0; b1; b2; b3]) with 4; omega).
  do 4 rewrite Int.repr_unsigned.
  reflexivity.
Qed.

Lemma initial_round_equiv: forall S K,
  (mbed_tls_initial_add_round_key
    (map Int.unsigned (state_to_list S))
    (map Int.unsigned (block_to_ints K))
  ) = state_to_four_ints (AddRoundKey S K).
Proof.
  intros.
  destruct S as [[[w0 w1] w2] w3].
  destruct w0 as [[[?p0 ?p0] ?p0] ?p0].
  destruct w1 as [[[?p0 ?p0] ?p0] ?p0].
  destruct w2 as [[[?p0 ?p0] ?p0] ?p0].
  destruct w3 as [[[?p0 ?p0] ?p0] ?p0].
  destruct K as [[[w0 w1] w2] w3].
  destruct w0 as [[[?k0 ?k0] ?k0] ?k0].
  destruct w1 as [[[?k0 ?k0] ?k0] ?k0].
  destruct w2 as [[[?k0 ?k0] ?k0] ?k0].
  destruct w3 as [[[?k0 ?k0] ?k0] ?k0].

  (* simpl LHS (low level) *)
  unfold mbed_tls_initial_add_round_key.
  unfold mbed_tls_initial_add_round_key_col.
  match goal with
  | |- context [ Znth 3 ?l ?d ] => let l' := (eval_list l) in change l with l'
  end.
  match goal with
  | |- context [ Znth 0 (?e0 :: ?rest) ?d ] =>
    change (Znth 0 (e0 :: rest) d) with e0
  end.
  match goal with
  | |- context [ Znth 1 (?e0 :: ?e1 :: ?rest) ?d ] =>
    change (Znth 1 (e0 :: e1 :: rest) d) with e1
  end.
  match goal with
  | |- context [ Znth 2 (?e0 :: ?e1 :: ?e2 :: ?rest) ?d ] =>
    change (Znth 2 (e0 :: e1 :: e2 :: rest) d) with e2
  end.
  match goal with
  | |- context [ Znth 3 (?e0 :: ?e1 :: ?e2 :: ?e3 :: ?rest) ?d ] =>
    change (Znth 3 (e0 :: e1 :: e2 :: e3 :: rest) d) with e3
  end.
  match goal with
  | |- context [ map Int.unsigned ?l ] => let l' := (eval_list l) in change l with l'
  end.
  rewrite (get_uint32_le_sublist (0 * 4)) by (simpl; omega).
  rewrite (get_uint32_le_sublist (1 * 4)) by (simpl; omega).
  rewrite (get_uint32_le_sublist (2 * 4)) by (simpl; omega).
  rewrite (get_uint32_le_sublist (3 * 4)) by (simpl; omega).
  do 4 rewrite sublist_map.
  do 4 match goal with
  | |- context [sublist ?i ?j ?l] =>
    let r := eval_list (sublist i j l) in change (sublist i j l) with r
  end.
  do 4 rewrite Int.repr_unsigned.
  do 4 rewrite get_uint32_le_word_to_int.
  do 4 rewrite xor_word_to_int.

  (* simpl RHS (high level) *)
  unfold AddRoundKey. unfold transpose. unfold xor_word. unfold state_to_four_ints, transpose.

  reflexivity.
Qed.

Definition FT0b0(i: Z): int := GF_ops_LL.times2 (Znth i FSb Int.zero).
Definition FT0b1(i: Z): int := Znth i FSb Int.zero.
Definition FT0b2(i: Z): int := Znth i FSb Int.zero.
Definition FT0b3(i: Z): int := GF_ops_LL.times3 (Znth i FSb Int.zero).
(* Note: according to calc_FT0, it should FT0b3 is
     (Int.and (Int.xor (GF_ops_LL.times2 (Znth i FSb Int.zero)) (Znth i FSb Int.zero)) (Int.repr 255))
   but we prefer to use an equivalent "medium-level" formulation *)

Lemma times3_times2: forall i,
  0 <= Int.unsigned i < 256 ->
  Int.and (Int.xor (times2 i) i) (Int.repr 255) = times3 i.
Proof.
  intros. unfold times2, times3.
  rewrite <- (mask_byte_nop _ H) at 3.
  repeat rewrite <- (Int.and_commut (Int.repr 255)).
  rewrite <- Int.and_xor_distrib.
  rewrite <- Int.and_assoc.
  rewrite Int.and_idem.
  f_equal. rewrite Int.xor_commut.
  reflexivity.
Qed.

Lemma calc_FT0_expose_bytes: forall i,
  0 <= i < 256 ->
  calc_FT0 i = word_to_int (FT0b0 i, FT0b1 i, FT0b2 i, FT0b3 i).
Proof.
  intros.
  Transparent calc_FT0. unfold calc_FT0.
  unfold word_to_int.
  unfold FT0b0, FT0b1, FT0b2, FT0b3.
  rewrite xor_is_or_4_bytes.
  f_equal. f_equal. apply times3_times2. apply FSb_range.
Qed.

Lemma calc_FT1_expose_bytes: forall i,
  0 <= i < 256 ->
  calc_FT1 i = word_to_int (FT0b3 i, FT0b0 i, FT0b1 i, FT0b2 i).
Proof.
  intros.
  Transparent calc_FT1. unfold calc_FT1.
  rewrite calc_FT0_expose_bytes by assumption.
  rewrite rot8_word_to_int.
  reflexivity.
Qed.

Lemma calc_FT2_expose_bytes: forall i,
  0 <= i < 256 ->
  calc_FT2 i = word_to_int (FT0b2 i, FT0b3 i, FT0b0 i, FT0b1 i).
Proof.
  intros.
  Transparent calc_FT2. unfold calc_FT2, calc_FT1.
  rewrite calc_FT0_expose_bytes by assumption.
  do 2 rewrite rot8_word_to_int.
  reflexivity.
Qed.

Lemma calc_FT3_expose_bytes: forall i,
  0 <= i < 256 ->
  calc_FT3 i = word_to_int (FT0b1 i, FT0b2 i, FT0b3 i, FT0b0 i).
Proof.
  intros.
  Transparent calc_FT3. unfold calc_FT3, calc_FT2, calc_FT1.
  rewrite calc_FT0_expose_bytes by assumption.
  do 3 rewrite rot8_word_to_int.
  reflexivity.
Qed.

Lemma split_quad_eq': forall {T : Type} (c0 c1 c2 c3 c0' c1' c2' c3' : T),
  c0 = c0' -> c1 = c1' -> c2 = c2' -> c3 = c3' -> (c0, (c1, (c2, c3))) = (c0', (c1', (c2', c3'))).
Proof.
  intros. congruence.
Qed.

Lemma xor_assoc_5: forall i0 i1 i2 i3 i4,
  Int.xor (Int.xor (Int.xor (Int.xor i4 i0) i1) i2) i3 =
  Int.xor (Int.xor (Int.xor (Int.xor i0 i1) i2) i3) i4.
Proof.
  intros.
  rewrite <- (Int.xor_commut i4).
  repeat rewrite Int.xor_assoc.
  reflexivity.
Qed.

Axiom byte_range_admit: forall b, 0 <= Int.unsigned b < 256.

Lemma round_equiv: forall S K,
  (mbed_tls_fround
    (state_to_four_ints S)
    (map Int.unsigned (block_to_ints K))
    0
  ) = state_to_four_ints (round S K).
Proof.
  intros.
  destruct S as [[[w0 w1] w2] w3].
  destruct w0 as [[[?p0 ?p0] ?p0] ?p0].
  destruct w1 as [[[?p0 ?p0] ?p0] ?p0].
  destruct w2 as [[[?p0 ?p0] ?p0] ?p0].
  destruct w3 as [[[?p0 ?p0] ?p0] ?p0].
  destruct K as [[[w0 w1] w2] w3].
  destruct w0 as [[[?k0 ?k0] ?k0] ?k0].
  destruct w1 as [[[?k0 ?k0] ?k0] ?k0].
  destruct w2 as [[[?k0 ?k0] ?k0] ?k0].
  destruct w3 as [[[?k0 ?k0] ?k0] ?k0].

  (* unfold LHS (low level): *)
  unfold mbed_tls_fround. unfold state_to_four_ints.
  match goal with
  | |- context [ Znth (0 + 3) ?l ?d ] => let l' := (eval_list l) in change l with l'
  end.
  match goal with
  | |- context [ Znth 0 (?e0 :: ?rest) ?d ] =>
    change (Znth 0 (e0 :: rest) d) with e0
  end.
  match goal with
  | |- context [ Znth (0 + 1) (?e0 :: ?e1 :: ?rest) ?d ] =>
    change (Znth (0 + 1) (e0 :: e1 :: rest) d) with e1
  end.
  match goal with
  | |- context [ Znth (0 + 2) (?e0 :: ?e1 :: ?e2 :: ?rest) ?d ] =>
    change (Znth (0 + 2) (e0 :: e1 :: e2 :: rest) d) with e2
  end.
  match goal with
  | |- context [ Znth (0 + 3) (?e0 :: ?e1 :: ?e2 :: ?e3 :: ?rest) ?d ] =>
    change (Znth (0 + 3) (e0 :: e1 :: e2 :: e3 :: rest) d) with e3
  end.
  unfold mbed_tls_fround_col.
  unfold transpose.
  do 4 rewrite byte0_word_to_int.
  do 4 rewrite byte1_word_to_int.
  do 4 rewrite byte2_word_to_int.
  do 4 rewrite byte3_word_to_int.
  do 4 rewrite Int.repr_unsigned.

  (* unfold RHS (high level): *)
  unfold round. unfold AddRoundKey, MixColumns, ShiftRows, SubBytes.
  unfold transpose. unfold sub_word, xor_word, transform_column.

  Transparent FT0 FT1 FT2 FT3.
  unfold FT0, FT1, FT2, FT3.
  assert (forall b, 0 <= Int.unsigned b < 256) as B by apply byte_range_admit.
  do 16 rewrite Znth_fill_list by apply B.

  do 4 rewrite calc_FT0_expose_bytes by apply B.
  do 4 rewrite calc_FT1_expose_bytes by apply B.
  do 4 rewrite calc_FT2_expose_bytes by apply B.
  do 4 rewrite calc_FT3_expose_bytes by apply B.

  repeat rewrite xor_word_to_int.
  unfold FT0b0, FT0b1, FT0b2, FT0b3.
  repeat rewrite equiv_sbox.
  repeat rewrite times2_equiv by apply B.
  repeat rewrite times3_equiv by apply B.
  repeat rewrite <- Int.xor_assoc.

  apply split_quad_eq'; f_equal; apply split_quad_eq; apply xor_assoc_5.
Qed.

Lemma final_round_equiv: forall S K,
  (mbed_tls_final_fround
    (state_to_four_ints S)
    (map Int.unsigned (block_to_ints K))
    0
  ) = state_to_four_ints (last_round S K).
Proof.
  intros.
  destruct S as [[[w0 w1] w2] w3].
  destruct w0 as [[[?p0 ?p0] ?p0] ?p0].
  destruct w1 as [[[?p0 ?p0] ?p0] ?p0].
  destruct w2 as [[[?p0 ?p0] ?p0] ?p0].
  destruct w3 as [[[?p0 ?p0] ?p0] ?p0].
  destruct K as [[[w0 w1] w2] w3].
  destruct w0 as [[[?k0 ?k0] ?k0] ?k0].
  destruct w1 as [[[?k0 ?k0] ?k0] ?k0].
  destruct w2 as [[[?k0 ?k0] ?k0] ?k0].
  destruct w3 as [[[?k0 ?k0] ?k0] ?k0].

  (* unfold LHS (low level): *)
  unfold mbed_tls_final_fround. unfold state_to_four_ints.
  match goal with
  | |- context [ Znth (0 + 3) ?l ?d ] => let l' := (eval_list l) in change l with l'
  end.
  match goal with
  | |- context [ Znth 0 (?e0 :: ?rest) ?d ] =>
    change (Znth 0 (e0 :: rest) d) with e0
  end.
  match goal with
  | |- context [ Znth (0 + 1) (?e0 :: ?e1 :: ?rest) ?d ] =>
    change (Znth (0 + 1) (e0 :: e1 :: rest) d) with e1
  end.
  match goal with
  | |- context [ Znth (0 + 2) (?e0 :: ?e1 :: ?e2 :: ?rest) ?d ] =>
    change (Znth (0 + 2) (e0 :: e1 :: e2 :: rest) d) with e2
  end.
  match goal with
  | |- context [ Znth (0 + 3) (?e0 :: ?e1 :: ?e2 :: ?e3 :: ?rest) ?d ] =>
    change (Znth (0 + 3) (e0 :: e1 :: e2 :: e3 :: rest) d) with e3
  end.
  unfold mbed_tls_final_fround_col.
  unfold transpose.
  do 4 rewrite byte0_word_to_int.
  do 4 rewrite byte1_word_to_int.
  do 4 rewrite byte2_word_to_int.
  do 4 rewrite byte3_word_to_int.
  do 4 rewrite Int.repr_unsigned.
  do 4 rewrite xor_byte0_with_FSb.
  do 4 rewrite xor_byte1_with_FSb.
  do 4 rewrite xor_byte2_with_FSb.
  do 4 rewrite xor_byte3_with_FSb.

  (* unfold RHS (high level): *)
  unfold last_round. unfold AddRoundKey, ShiftRows, SubBytes.
  unfold transpose. unfold sub_word, xor_word.

  do 16 rewrite equiv_sbox.
  do 16 match goal with
  | |- context [Int.xor (look_sbox ?p) ?k] => rewrite (Int.xor_commut (look_sbox p) k)
  end.
  reflexivity.
Qed.

Ltac eta5 HH :=
  let Hnew := fresh in match type of HH with
  | ?f = (fun a1 a2 a3 a4 a5 => ?e) =>
    assert (forall a1 a2 a3 a4 a5, f a1 a2 a3 a4 a5 = e) as Hnew by (intro; rewrite HH; reflexivity)
  end;
  clear HH; rename Hnew into HH.

Lemma mbed_tls_initial_round_sublist: forall s ks,
  4 <= Zlength ks ->
  mbed_tls_initial_add_round_key s ks = mbed_tls_initial_add_round_key s (sublist 0 4 ks).
Proof.
  intros.
  unfold mbed_tls_initial_add_round_key.
  unfold mbed_tls_initial_add_round_key_col.
  do 4 rewrite Znth_sublist by omega.
  reflexivity.
Qed.

Lemma mbed_tls_fround_sublist: forall i s ks,
  0 <= i <= Zlength ks - 4 ->
  mbed_tls_fround s ks i = mbed_tls_fround s (sublist i (i+4) ks) 0.
Proof.
  intros. unfold mbed_tls_fround.
  do 4 rewrite Znth_sublist by omega.
  replace (0 + i) with i by omega.
  replace (0 + 1 + i) with (i + 1) by omega.
  replace (0 + 2 + i) with (i + 2) by omega.
  replace (0 + 3 + i) with (i + 3) by omega.
  reflexivity.
Qed.

Lemma mbed_tls_final_fround_sublist: forall i s ks,
  0 <= i <= Zlength ks - 4 ->
  mbed_tls_final_fround s ks i = mbed_tls_final_fround s (sublist i (i+4) ks) 0.
Proof.
  intros. unfold mbed_tls_final_fround.
  do 4 rewrite Znth_sublist by omega.
  replace (0 + i) with i by omega.
  replace (0 + 1 + i) with (i + 1) by omega.
  replace (0 + 2 + i) with (i + 2) by omega.
  replace (0 + 3 + i) with (i + 3) by omega.
  reflexivity.
Qed.

Lemma HL_equiv_LL_encryption: forall exp_key plaintext,
  Zlength exp_key = 15 ->
  (mbed_tls_aes_enc
     (map Int.unsigned (state_to_list plaintext))
     ((blocks_to_Zwords exp_key) ++ (list_repeat (8%nat) 0))
  ) = output_four_ints_as_bytes (state_to_four_ints (Cipher exp_key plaintext)).
Proof.
  intros.
  unfold mbed_tls_aes_enc. cbv zeta. f_equal.
  do 15 (destruct exp_key as [ | [[[?k0 ?k0] ?k0] ?k0] exp_key]; [ inversion H | ]).
  assert (exp_key = nil). {
    destruct exp_key; [ reflexivity | ].
    exfalso. do 16 rewrite Zlength_cons in H.
    pose proof (Zlength_nonneg exp_key). omega.
  }
  subst exp_key. clear H.

  (* simpl LHS (low level) *)
  match goal with
  | |- context [?l1 ++ ?l2] =>
    let r := eval_list (l1 ++ l2) in change (l1 ++ l2) with r
  end.
  rewrite mbed_tls_final_fround_sublist by (simpl; omega).
  unfold mbed_tls_enc_rounds.
  simpl (4 + 4 * Z.of_nat _).
  rewrite (mbed_tls_fround_sublist 4) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 8) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 12) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 16) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 20) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 24) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 28) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 32) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 36) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 40) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 44) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 48) by (simpl; omega).
  rewrite (mbed_tls_fround_sublist 52) by (simpl; omega).
  rewrite mbed_tls_initial_round_sublist by (cbv; intro; discriminate).
  do 15 match goal with
  | |- context [sublist ?i ?j ?l] =>
    let r := eval_list (sublist i j l) in change (sublist i j l) with r
  end.

  (* simpl RHS (high level) *)
  unfold Cipher.
  unfold apply_rounds.

  (* apply equivalence lemmas for rounds *)
  rewrite <- final_round_equiv. f_equal.
  do 13 (rewrite <- round_equiv; f_equal).
  rewrite <- initial_round_equiv. f_equal.
Qed.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas64_2e189m25_4limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition mul :
  { mul : feBW_loose -> feBW_loose -> feBW_tight
  | forall a b, phiBW_tight (mul a b) = F.mul (phiBW_loose a) (phiBW_loose b) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_mul ().
  Show Ltac Profile.
Time Defined.

Print Assumptions mul.


Require Import Crypto.Arithmetic.PrimeFieldTheorems.
Require Import Crypto.Specific.solinas64_2e171m19_3limbs.Synthesis.

(* TODO : change this to field once field isomorphism happens *)
Definition mul :
  { mul : feBW_loose -> feBW_loose -> feBW_tight
  | forall a b, phiBW_tight (mul a b) = F.mul (phiBW_loose a) (phiBW_loose b) }.
Proof.
  Set Ltac Profiling.
  Time synthesize_mul ().
  Show Ltac Profile.
Time Defined.

Print Assumptions mul.


(* This file is extracted from the TLC library.
   http://github.com/charguer/tlc
   DO NOT EDIT. *)

(**************************************************************************
* TLC: A library for Coq                                                  *
* Integers                                                                *
**************************************************************************)

Set Implicit Arguments.
Require Export Coq.ZArith.ZArith.
From SLF Require Import LibTactics LibLogic LibReflect LibRelation.
Export LibTacticsCompatibility.
From SLF Require Export LibNat.

(* --LATER: rename [plus] to [add] everywhere? *)

(* ********************************************************************** *)
(* ################################################################# *)
(** * Parsing of integers and operations *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Notation for type and operation *)

(** Define [int] as an alias for [Z], the type of integers from Coq's stdlib. *)

Declare Scope Int_scope.
Notation "'int'" := Z : Int_scope.
Delimit Scope Int_scope with I.

Local Open Scope Int_scope.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Inhabited type *)

Instance Inhab_int : Inhab int.
Proof using. intros. apply (Inhab_of_val 0%Z). Qed.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Coercion from nat *)

(** Remark: we cannot simply use the coercion:
      Coercion Z_of_nat : nat >-> Z.
   because otherwise when we try to make the coercion opaque using:
      Opaque Z_of_nat.
   the lia fails to work.
   Thus, we introduce an alias, called [nat_to_Z] for [Z_of_nat],
   and we register [nat_to_Z] as coercion.
*)

Definition nat_to_Z := Z_of_nat.

Lemma nat_to_Z_eq_Z_of_nat : nat_to_Z = Z_of_nat.
Proof using. reflexivity. Qed.

Global Opaque nat_to_Z.

Coercion nat_to_Z : nat >-> Z.

(* --TODO: check this coercion is actually the one in use *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Order relation *)

(** The comparison operators on integers are those from [LibOrder],
    not the ones from Coq's [ZArith]. *)

Open Scope Z_scope.
Open Scope comp_scope.

(** The typeclass [le] on type [int] is bound to [Zle], from Coq's
    standard library *)

Instance le_int_inst : Le int := Build_Le Z.le.

(* ********************************************************************** *)
(* ################################################################# *)
(** * Conversion to natural numbers, for tactic programming *)

(** These tactics are helpful to convert a number passed to a Ltac tactic
    into a [nat], regardless of whether it is a [nat] or an [int]. *)

Definition ltac_int_to_nat (x:Z) : nat :=
  match x with
  | Z0 => 0%nat
  | Zpos p => nat_of_P p
  | Zneg p => 0%nat
  end.

Ltac number_to_nat N ::=
  match type of N with
  | nat => constr:(N)
  | int => let N' := constr:(ltac_int_to_nat N) in eval compute in N'
  | Z => let N' := constr:(ltac_int_to_nat N) in eval compute in N'
  (*todo: last case not needed*)
  end.

(* ********************************************************************** *)
(* ################################################################# *)
(** * Decision procedure *)

(** A lot of hacks to allow calling the [lia] tactic *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Translation from typeclass order to ZArith, for using [lia] *)

Lemma le_zarith : le = Z.le.
Proof using. extens*. Qed.

Global Opaque le_int_inst.

Lemma lt_zarith : lt = Z.lt.
Proof using.
  extens. rew_to_le. rewrite le_zarith.
  unfold strict. intros. lia.
Qed.

Lemma ge_zarith : ge = Z.ge.
Proof using.
  extens. rew_to_le. rewrite le_zarith.
  unfold inverse. intros. lia.
Qed.

Lemma gt_zarith : gt = Z.gt.
Proof using.
  extens. rew_to_le. rewrite le_zarith.
  unfold strict, inverse. intros. lia.
Qed.

Hint Rewrite le_zarith lt_zarith ge_zarith gt_zarith : rew_int_comp.

Ltac int_comp_to_zarith :=
  autorewrite with rew_int_comp in *.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Hypothesis selection *)

(** [is_arity_type T] returns a boolean indicating whether
    [T] is equal to [nat] or [int] *)

Ltac is_arith_type T :=
  match T with
  | nat => constr:(true)
  | int => constr:(true)
  | _ => constr:(false)
  end.

(** [is_arity E] returns a boolean indicating whether
    [E] is an arithmetic expression *)

Ltac is_arith E :=
  match E with
  | _ = _ :> ?T => is_arith_type T
  | _ <> _ :> ?T => is_arith_type T
  | ~ ?E' => is_arith E'
  | ?E' -> False => is_arith E'
  | @le ?T _ _ _ => is_arith_type T
  | @ge ?T _ _ _ => is_arith_type T
  | @lt ?T _ _ _ => is_arith_type T
  | @gt ?T _ _ _ => is_arith_type T
  | (_ <= _)%Z => constr:(true)
  | (_ >= _)%Z => constr:(true)
  | (_ < _)%Z => constr:(true)
  | (_ > _)%Z => constr:(true)
  | (_ <= _)%nat => constr:(true)
  | (_ >= _)%nat => constr:(true)
  | (_ < _)%nat => constr:(true)
  | (_ > _)%nat => constr:(true)
  | _ => constr:(false)
  end.

(** [arith_goal_or_false] looks at the current goal and
    replaces it with [False] if it is not an arithmetic goal*)

Ltac arith_goal_or_false :=
  match goal with |- ?E =>
    match is_arith E with
    | true => idtac
    | false => false
    end
  end.

(** [generalize_arith] generalizes all hypotheses which correspond
    to some arithmetic goal. It destructs conjunctions on the fly. *)

Lemma istrue_isTrue_forw : forall (P:Prop),
  istrue (isTrue P) ->
  P.
Proof using. introv H. rew_istrue~ in H. Qed.

Ltac generalize_arith :=
  repeat match goal with
  | H: istrue (isTrue _) |- _ => generalize (@istrue_isTrue_forw _ H); clear H; intro
  | H:?E1 /\ ?E2 |- _ => destruct H
  | H: ?E -> False |- _ =>
    match is_arith E with
    | true => change (E -> False) with (~ E) in H
    | false => clear H
    end
  | H:?E |- _ =>
    match is_arith E with
    | true => generalize H; clear H (* --todo: revert H? *)
    | false => clear H
    end
  end.

(* --TODO:
Ltac split_if_eq_bool :=
  let go _ := apply eq_bool_prove; intros in
  match goal with
  | |- @eq bool _ _ => go tt
  | |- istrue (@eqb bool _ _ _) => apply eq_to_equ; go tt
  end.
*)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Normalization of arithmetic expressions *)

(** Two lemmas to help lia out *)

Lemma Z_of_nat_O :
  Z_of_nat O = 0.
Proof using. reflexivity. Qed.

Lemma Z_of_nat_S : forall n,
  Z_of_nat (S n) = Z.succ (Z_of_nat n).
Proof using. intros. rewrite~ <- Zpos_P_of_succ_nat. Qed.

Lemma Z_of_nat_plus1 : forall n,
  Z_of_nat (1 + n) = Z.succ (Z_of_nat n).
Proof using. intros. rewrite <- Z_of_nat_S. fequals~. Qed.

(** [rew_maths] rewrite any lemma in the base [rew_maths].
    The goal should not contain any evar, otherwise tactic might loop. *)

Hint Rewrite nat_to_Z_eq_Z_of_nat Z_of_nat_O Z_of_nat_S Z_of_nat_plus1 : rew_maths.

Ltac rew_maths :=
  autorewrite with rew_maths in *.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Setting up the goal for [lia] *)

(** [math_setup_goal] does introduction, splits, and replace
    the goal by [False] if it is not arithmetic. If the goal
    is of the form [P1 = P2 :> Prop], then the goal is
    changed to [P1 <-> P2]. *)

Ltac math_setup_goal_step tt :=
  match goal with
  | |- _ -> _ => intro
  | |- _ <-> _ => iff
  | |- forall _, _  => intro
  | |- _ /\ _ => split
  | |- _ = _ :> Prop => apply prop_ext; iff
  end.

Ltac math_setup_goal :=
  repeat (math_setup_goal_step tt);
  arith_goal_or_false.

  (* DEPRECATED
  Ltac math_setup_goal :=
    intros;
    try match goal with |- _ /\ _ => split end;
    try match goal with |- _ = _ :> Prop => apply prop_ext; iff end;
    arith_goal_or_false.
    (* try split_if_eq_bool. *)
  *)

(* --TODO; [int_nat_conv]
Lemma int_nat_plus : forall (n m:nat),
  (n + m)%nat = (n + m)%Z :> int.
Proof using. applys inj_plus. Qed.
Hint Rewrite int_nat_plus : int_nat_conv.
*)

(** [math] tactics performs several preprocessing step,
    selects all arithmetic hypotheses, and the call lia. *)
(* --TODO: autorewrite with int_nat_conv in *. after int_comp_to_zarith *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Main driver for the set up process to goal [lia] *)

(* --TODO: this probably is no longer necessary, since
     LibTactic version seems equivalent *)
Ltac check_noevar_goal ::=
  match goal with |- ?G => first [ has_evar G; fail 1 | idtac ] end.

Ltac math_0 := idtac.
Ltac math_1 := intros; generalize_arith.
(* Work around for the slow [autorewrite in *] *)
Ltac math_2 := instantiate; check_noevar_goal.
Ltac math_3 := autorewrite with rew_maths rew_int_comp rew_nat_comp; intros.
(* original:
Ltac math_2 := instantiate; check_noevar_goal; intros.
Ltac math_3 := rew_maths; nat_comp_to_peano; int_comp_to_zarith.
*)
Ltac math_4 := math_setup_goal.
Ltac math_5 := lia.

Ltac math_setup := math_0; math_1; math_2; math_3; math_4.
Ltac math_base := math_setup; math_5.

Tactic Notation "math" := math_base.

Tactic Notation "math" simple_intropattern(I) ":" constr(E) :=
  asserts I: E; [ math | ].
Tactic Notation "maths" constr(E) :=
  let H := fresh "H" in asserts H: E; [ math | ].
(* --TODO: parsing conflit *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** [math] tactic restricted to arithmetic goals *)

(** [math_only] calls [math] but only on goals which
    have an arithmetic form. Thus, contracty to [math],
    it does not attempt to look for a contradiction in
    the hypotheses if the conclusion is not an arithmetic
    goal. Useful for efficiency. *)

Ltac math_only_if_arith_core tt :=
  match goal with |- ?T =>
    match is_arith T with true => math end end.

Tactic Notation "math_only_if_arith" :=
  math_only_if_arith_core tt.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Elimination of multiplication, to call lia *)

(* In order to use [math] with simple multiplications, add the command:
     Hint Rewrite mult_2_eq_plus mult_3_eq_plus : rew_maths.
   TEMPORARY: these lemmas should go away as [lia] is able to inline
   trivial multiplication by itself
*)

Lemma mult_2_eq_plus : forall x, 2 * x = x + x.
Proof using. intros. ring. Qed.

Lemma mult_3_eq_plus : forall x, 3 * x = x + x + x.
Proof using. intros. ring. Qed.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Hint externs for calling math in the hint base [maths] *)

(* --TODO: rename [maths] database to [math] *)

Ltac math_hint := math.

Hint Extern 3 (_ = _ :> nat) => math_hint : maths.
Hint Extern 3 (_ = _ :> int) => math_hint : maths.
Hint Extern 3 (_ <> _ :> nat) => math_hint : maths.
Hint Extern 3 (_ <> _ :> int) => math_hint : maths.
Hint Extern 3 (istrue (isTrue (_ = _ :> nat))) => math_hint : maths.
Hint Extern 3 (istrue (isTrue (_ = _ :> int))) => math_hint : maths.
Hint Extern 3 (istrue (isTrue (_ <> _ :> nat))) => math_hint : maths.
Hint Extern 3 (istrue (isTrue (_ <> _ :> int))) => math_hint : maths.
Hint Extern 3 ((_ <= _)%nat) => math_hint : maths.
Hint Extern 3 ((_ >= _)%nat) => math_hint : maths.
Hint Extern 3 ((_ < _)%nat) => math_hint : maths.
Hint Extern 3 ((_ > _)%nat) => math_hint : maths.
Hint Extern 3 ((_ <= _)%Z) => math_hint : maths.
Hint Extern 3 ((_ >= _)%Z) => math_hint : maths.
Hint Extern 3 ((_ < _)%Z) => math_hint : maths.
Hint Extern 3 ((_ > _)%Z) => math_hint : maths.
Hint Extern 3 (@le nat _ _ _) => math_hint : maths.
Hint Extern 3 (@lt nat _ _ _) => math_hint : maths.
Hint Extern 3 (@ge nat _ _ _) => math_hint : maths.
Hint Extern 3 (@gt nat _ _ _) => math_hint : maths.
Hint Extern 3 (@le int _ _ _) => math_hint : maths.
Hint Extern 3 (@lt int _ _ _) => math_hint : maths.
Hint Extern 3 (@ge int _ _ _) => math_hint : maths.
Hint Extern 3 (@gt int _ _ _) => math_hint : maths.
Hint Extern 3 (~ @le int _ _ _) => unfold not; math_hint : maths.
Hint Extern 3 (~ @lt int _ _ _) => unfold not; math_hint : maths.
Hint Extern 3 (~ @ge int _ _ _) => unfold not; math_hint : maths.
Hint Extern 3 (~ @gt int _ _ _) => unfold not; math_hint : maths.
Hint Extern 3 (~ @eq int _ _) => unfold not; math_hint : maths.
Hint Extern 3 (@le int _ _ _ -> False) => math_hint : maths.
Hint Extern 3 (@lt int _ _ _ -> False) => math_hint : maths.
Hint Extern 3 (@ge int _ _ _ -> False) => math_hint : maths.
Hint Extern 3 (@gt int _ _ _ -> False) => math_hint : maths.
Hint Extern 3 (@eq int _ _ -> False) => math_hint : maths.
Hint Extern 3 (~ @le nat _ _ _) => unfold not; math_hint : maths.
Hint Extern 3 (~ @lt nat _ _ _) => unfold not; math_hint : maths.
Hint Extern 3 (~ @ge nat _ _ _) => unfold not; math_hint : maths.
Hint Extern 3 (~ @gt nat _ _ _) => unfold not; math_hint : maths.
Hint Extern 3 (~ @eq nat _ _) => unfold not; math_hint : maths.
Hint Extern 3 (@le nat _ _ _ -> False) => math_hint : maths.
Hint Extern 3 (@lt nat _ _ _ -> False) => math_hint : maths.
Hint Extern 3 (@ge nat _ _ _ -> False) => math_hint : maths.
Hint Extern 3 (@gt nat _ _ _ -> False) => math_hint : maths.
Hint Extern 3 (@eq nat _ _ -> False) => math_hint : maths.

(* ********************************************************************** *)
(* ################################################################# *)
(** * Rewriting on arithmetic expressions *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Rewriting equalities provable by the [math] tactic *)

(** [math_rewrite (E = F)] replaces all occurences of [E]
    with the expression [F]. It produces the equality [E = F]
    as subgoal, and tries to solve it using the tactic [math] *)

Tactic Notation "math_rewrite" constr(E) :=
  asserts_rewrite E; [ try math | ].
Tactic Notation "math_rewrite" constr(E) "in" hyp(H) :=
  asserts_rewrite E in H; [ try math | ].
Tactic Notation "math_rewrite" constr(E) "in" "*" :=
  asserts_rewrite E in *; [ try math | ].

Tactic Notation "math_rewrite" "~" constr(E) :=
  math_rewrite E; auto_tilde.
Tactic Notation "math_rewrite" "~" constr(E) "in" hyp(H) :=
  math_rewrite E in H; auto_tilde.
Tactic Notation "math_rewrite" "~" constr(E) "in" "*" :=
  math_rewrite E in *; auto_tilde.

Tactic Notation "math_rewrite" "*" constr(E) :=
  math_rewrite E; auto_star.
Tactic Notation "math_rewrite" "*" constr(E) "in" hyp(H) :=
  math_rewrite E in H; auto_star.
Tactic Notation "math_rewrite" "*" constr(E) "in" "*" :=
  math_rewrite E in *; auto_star.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Addition and substraction *)

Lemma plus_zero_r : forall n,
  n + 0 = n.
Proof using. math. Qed.

Lemma plus_zero_l : forall n,
  0 + n = n.
Proof using. math. Qed.

Lemma minus_zero_r : forall n,
  n - 0 = n.
Proof using. math. Qed.

Lemma minus_zero_l : forall n,
  0 - n = (-n).
Proof using. math. Qed.

Lemma mult_zero_l : forall n,
  0 * n = 0.
Proof using. math. Qed.

Lemma mult_zero_r : forall n,
  n * 0 = 0.
Proof using. math. Qed.

Lemma mult_one_l : forall n,
  1 * n = n.
Proof using. math. Qed.

Lemma mult_one_r : forall n,
  n * 1 = n.
Proof using. math. Qed.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Simplification tactic *)

(** [rew_int] performs some basic simplification on
    expressions involving integers *)

Hint Rewrite plus_zero_r plus_zero_l minus_zero_r minus_zero_l
  mult_zero_l mult_zero_r mult_one_l mult_one_r : rew_int.

Tactic Notation "rew_int" :=
  autorewrite with rew_int.
Tactic Notation "rew_int" "~" :=
  rew_int; auto_tilde.
Tactic Notation "rew_int" "*" :=
  rew_int; auto_star.
Tactic Notation "rew_int" "in" "*" :=
  autorewrite_in_star_patch ltac:(fun tt => autorewrite with rew_int).
  (* autorewrite with rew_int in *. *)
Tactic Notation "rew_int" "~" "in" "*" :=
  rew_int in *; auto_tilde.
Tactic Notation "rew_int" "*" "in" "*" :=
  rew_int in *; auto_star.
Tactic Notation "rew_int" "in" hyp(H) :=
  autorewrite with rew_int in H.
Tactic Notation "rew_int" "~" "in" hyp(H) :=
  rew_int in H; auto_tilde.
Tactic Notation "rew_int" "*" "in" hyp(H) :=
  rew_int in H; auto_star.

(* ********************************************************************** *)
(* ################################################################# *)
(** * Conversions of operations from [nat] to [int] and back *)

(** -- LATER: make proofs below no longer depend on Coq's stdlib *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Lifting of comparisons from [nat] to [int] *)

(* --TODO: perhaps only state those as equalities? *)

Lemma eq_nat_of_eq_int : forall (n m:nat),
  (n:int) = (m:int) ->
  n = m :> nat.
Proof using. math. Qed.

Lemma neq_nat_of_neq_int : forall (n m:nat),
  (n:int) <> (m:int) ->
  (n <> m)%nat.
Proof using. math. Qed.

Lemma eq_int_of_eq_nat : forall (n m:nat),
  n = m :> nat ->
  (n:int) = (m:int).
Proof using. math. Qed.

Lemma neq_int_of_neq_nat : forall (n m:nat),
  (n <> m)%nat ->
  (n:int) <> (m:int).
Proof using. math. Qed.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Lifting of inequalities from [nat] to [int] *)

Lemma le_nat_of_le_int : forall (n m:nat),
  (n:int) <= (m:int) ->
  (n <= m).
Proof using. math. Qed.

Lemma le_int_of_le_nat : forall (n m:nat),
  (n <= m) ->
  (n:int) <= (m:int).
Proof using. math. Qed.

Lemma lt_nat_of_lt_int : forall (n m:nat),
  (n:int) < (m:int) ->
  (n < m).
Proof using. math. Qed.

Lemma lt_int_of_lt_nat : forall (n m:nat),
  (n < m) ->
  (n:int) < (m:int).
Proof using. math. Qed.

Lemma ge_nat_of_ge_int : forall (n m:nat),
  (n:int) >= (m:int) ->
  (n >= m).
Proof using. math. Qed.

Lemma ge_int_of_ge_nat : forall (n m:nat),
  (n >= m) ->
  (n:int) >= (m:int).
Proof using. math. Qed.

Lemma gt_nat_of_gt_int : forall (n m:nat),
  (n:int) > (m:int) ->
  (n > m).
Proof using. math. Qed.

Lemma gt_int_of_gt_nat : forall (n m:nat),
  (n > m) ->
  (n:int) > (m:int).
Proof using. math. Qed.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Lifting of operations from [nat] to [int] *)

Lemma plus_nat_eq_plus_int : forall (n m:nat),
  (n+m)%nat = (n:int) + (m:int) :> int.
Proof using.
  Transparent nat_to_Z.
  intros. unfold nat_to_Z. applys Nat2Z.inj_add.
Qed.

Lemma minus_nat_eq_minus_int : forall (n m:nat),
  (n >= m)%nat ->
  (n-m)%nat = (n:int) - (m:int) :> int.
Proof using.
  Transparent nat_to_Z.
  intros. unfold nat_to_Z. applys Nat2Z.inj_sub. math.
Qed.

(* -- LATER: tactic for lifting all operators and comparisons into Z *)

(* -- LATER: complete with other operators *)

(* -- LATER: is the hint below really necessary?
     if so, there should probably be other hints similar to it *)

Hint Rewrite plus_nat_eq_plus_int : rew_maths.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Properties of comparison *)

Lemma antisym_le_int :
  antisym (le (A:=int)).
Proof using. intros x y L1 L2. math. Qed.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Absolute function in [nat] *)

Notation "'abs'" := Z.abs_nat (at level 0).

Global Arguments Z.abs : simpl never.
Global Arguments Z.abs_nat : simpl never.

Lemma abs_nat : forall (n:nat),
  abs n = n.
Proof using. exact Zabs_nat_Z_of_nat. Qed.

Lemma abs_nonneg : forall (x:int),
  x >= 0 ->
  abs x = x :> int.
Proof using.
  intros. rewrite inj_Zabs_nat.
  rewrite Z.abs_eq. math. math.
Qed.

Lemma abs_eq_nat_eq : forall (x:int) (y:nat),
  x >= 0 ->
  (abs x = y :> nat) = (x = Z_of_nat y :> int).
Proof using.
  introv M. extens. iff E.
  { subst. rewrite Zabs2Nat.id_abs, Z.abs_eq; math. }
  { subst. rewrite~ Zabs2Nat.id. }
Qed.

Lemma lt_abs_abs : forall (n m : int),
  (0 <= n) ->
  (n < m) ->
  (abs n < abs m).
Proof using.
  intros. nat_comp_to_peano. apply Zabs_nat_lt. math.
Qed.

Lemma abs_to_int : forall (n : int),
  0 <= n ->
  Z_of_nat (abs n) = n.
Proof using. intros. rewrite~ abs_nonneg. Qed.

Lemma abs_le_nat_le : forall (x:int) (y:nat),
  (0 <= x) ->
  (abs x <= y) = (x <= y)%Z.
Proof.
  intros. extens. iff E.
  { rewrites~ <-(>> abs_to_int x). math. }
  { rewrites~ <-(>> abs_to_int x) in E. math. }
Qed.

Lemma abs_ge_nat_ge : forall (x:int) (y:nat),
  (0 <= x) ->
  (abs x >= y) = (x >= y)%Z .
Proof.
  intros. extens. iff E.
  { rewrites~ <-(>> abs_to_int x). math. }
  { rewrites~ <-(>> abs_to_int x) in E. math. }
Qed.

(** -- TODO: many useful lemmas missing *)

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** [abs] distribute on constants and operators *)

Lemma abs_0 : abs 0 = 0%nat :> nat.
Proof using. reflexivity. Qed.

Lemma abs_1 : abs 1 = 1%nat :> nat.
Proof using. reflexivity. Qed.

Lemma abs_plus : forall (x y:int),
  (x >= 0) ->
  (y >= 0) ->
  abs (x + y) = (abs x + abs y)%nat :> nat.
Proof using. intros. applys Zabs2Nat.inj_add; math. Qed.

Lemma abs_minus : forall (x y:int),
  (x >= y) ->
  (y >= 0) ->
  abs (x - y) = (abs x - abs y)%nat :> nat.
Proof using. intros. applys Zabs2Nat.inj_sub; math. Qed.

Lemma abs_nat_plus_nonneg : forall (n:nat) (x:int),
  x >= 0 ->
 abs (n + x)%Z = (n + abs x)%nat.
Proof using.
  introv N. applys eq_nat_of_eq_int.
  rewrite plus_nat_eq_plus_int.
  do 2 (rewrite abs_nonneg; [|math]). auto.
Qed.

Lemma abs_gt_minus_nat : forall (n:nat) (x:int),
  (x >= n)%Z ->
 abs (x - n)%Z = (abs x - n)%nat.
Proof using.
  introv N. applys eq_nat_of_eq_int.
  rewrite minus_nat_eq_minus_int.
  do 2 (rewrite abs_nonneg; [|math]). auto.
  applys ge_nat_of_ge_int. rewrite abs_nonneg; math.
Qed.

Lemma succ_abs_eq_abs_one_plus : forall (x:int),
  x >= 0 ->
  S (abs x) = abs (1 + x) :> nat.
Proof using.
  intros x. pattern x. applys (@measure_induction _ abs). clear x.
  intros x IH Pos. rewrite <- Zabs_nat_Zsucc. fequals. math. math.
Qed.

Lemma abs_eq_succ_abs_minus_one : forall (x:int),
  x > 0 ->
  abs x = S (abs (x - 1)) :> nat.
Proof using.
  intros. apply eq_nat_of_eq_int.
  rewrite abs_nonneg; try math.
Qed.

(* ---------------------------------------------------------------------- *)
(** ** Tactic [rew_abs_nonneg] to normalize expressions involving [abs]
       issuing side-conditions that arguments are nonnegative *)

Hint Rewrite abs_nat abs_0 abs_1 abs_plus abs_nonneg : rew_abs_nonneg.

Tactic Notation "rew_abs_nonneg" :=
  autorewrite with rew_abs_nonneg.
Tactic Notation "rew_abs_nonneg" "~" :=
  autorewrite with rew_abs_nonneg; try math; autos~.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** Positive part of an integer. Returns 0 on negative values. *)

Notation "'to_nat'" := Z.to_nat (at level 0).

Lemma to_nat_nat : forall (n:nat),
  to_nat n = n.
Proof using. exact Nat2Z.id. Qed.

Lemma to_nat_nonneg : forall (x:int),
  x >= 0 ->
  to_nat x = x :> int.
Proof using. intros. apply~ Z2Nat.id. Qed.

Lemma to_nat_neg : forall (x:int),
  x <= 0 ->
  to_nat x = 0%nat.
Proof using.
  intros x H. destruct~ x.
  assert (Z.pos p = 0) as ->. { forwards: Zle_0_pos p. math. }
  reflexivity.
Qed.

Lemma to_nat_eq_nat_eq : forall (x:int) (y:nat),
  x >= 0 ->
  (to_nat x = y :> nat) = (x = Z_of_nat y :> int).
Proof using.
  introv M. extens. iff E.
  { subst. rewrite~ Z2Nat.id. }
  { subst. rewrite~ Nat2Z.id. }
Qed.

Lemma lt_to_nat_to_nat : forall (n m : int),
  (0 <= n) ->
  (n < m) ->
  (to_nat n < to_nat m).
Proof using.
  intros. nat_comp_to_peano.
  rewrite <-!Zabs2Nat.abs_nat_nonneg by math.
  apply~ Zabs_nat_lt. math.
Qed.

Lemma to_nat_to_int : forall (n : int),
  0 <= n ->
  Z_of_nat (to_nat n) = n.
Proof using. intros. rewrite~ to_nat_nonneg. Qed.

Lemma to_nat_le_nat_le : forall (x:int) (y:nat),
  (0 <= x) ->
  (to_nat x <= y) = (x <= y)%Z.
Proof.
  intros. extens. iff E.
  { rewrites~ <-(>> to_nat_to_int x). math. }
  { rewrites~ <-(>> to_nat_to_int x) in E. math. }
Qed.

Lemma to_nat_ge_nat_ge : forall (x:int) (y:nat),
  (0 <= x) ->
  (to_nat x >= y) = (x >= y)%Z .
Proof.
  intros. extens. iff E.
  { rewrites~ <-(>> to_nat_to_int x). math. }
  { rewrites~ <-(>> to_nat_to_int x) in E. math. }
Qed.

(* ---------------------------------------------------------------------- *)
(* ================================================================= *)
(** ** [to_nat] distribute on constants and operators *)

Lemma to_nat_0 : to_nat 0 = 0%nat :> nat.
Proof using. reflexivity. Qed.

Lemma to_nat_1 : to_nat 1 = 1%nat :> nat.
Proof using. reflexivity. Qed.

Lemma to_nat_plus : forall (x y:int),
  (x >= 0) ->
  (y >= 0) ->
  to_nat (x + y) = (to_nat x + to_nat y)%nat :> nat.
Proof using. intros. apply~ Z2Nat.inj_add. Qed.

Lemma to_nat_minus : forall (x y:int),
  (x >= y) ->
  (y >= 0) ->
  to_nat (x - y) = (to_nat x - to_nat y)%nat :> nat.
Proof using. intros. apply~ Z2Nat.inj_sub. Qed.

(* ---------------------------------------------------------------------- *)
(** ** Tactic [rew_to_nat_nonneg] to normalize expressions involving [to_nat]
       issuing side-conditions that arguments are nonnegative *)

Hint Rewrite to_nat_nat to_nat_0 to_nat_1 to_nat_plus to_nat_minus
     to_nat_nonneg : rew_to_nat_nonneg.

Tactic Notation "rew_to_nat_nonneg" :=
  autorewrite with rew_to_nat_nonneg.
Tactic Notation "rew_to_nat_nonneg" "~" :=
  autorewrite with rew_to_nat_nonneg; try math; autos~.

(* 2021-08-11 15:24 *)


Require Export unscoped header_extensible.
Require Export termsyntax.

Section form_conjunctive.
Context {Sigma : Signature}.

Variable form : Type.

Variable subst_form : forall   (sigmaterm : ( fin ) -> term ) (s : form ), form .

Variable idSubst_form : forall  (sigmaterm : ( fin ) -> term ) (Eqterm : forall x, sigmaterm x = (var_term ) x) (s : form ), subst_form sigmaterm s = s.

Variable ext_form : forall   (sigmaterm : ( fin ) -> term ) (tauterm : ( fin ) -> term ) (Eqterm : forall x, sigmaterm x = tauterm x) (s : form ), subst_form sigmaterm s = subst_form tauterm s.

Variable compSubstSubst_form : forall    (sigmaterm : ( fin ) -> term ) (tauterm : ( fin ) -> term ) (thetaterm : ( fin ) -> term ) (Eqterm : forall x, ((funcomp) (subst_term tauterm) sigmaterm) x = thetaterm x) (s : form ), subst_form tauterm (subst_form sigmaterm s) = subst_form thetaterm s.

Inductive form_conjunctive  : Type :=
  | Conj : ( form   ) -> ( form   ) -> form_conjunctive .

Variable retract_form_conjunctive : retract form_conjunctive form.

Definition Conj_  (s0 : form  ) (s1 : form  ) : _ :=
  inj (Conj s0 s1).

Lemma congr_Conj_  { s0 : form   } { s1 : form   } { t0 : form   } { t1 : form   } (H1 : s0 = t0) (H2 : s1 = t1) : Conj_  s0 s1 = Conj_  t0 t1 .
Proof. congruence. Qed.

(* Variable retract_ren_form : forall   (xiterm : ( fin ) -> fin) s, ren_form xiterm (inj s) = ren_form_conjunctive xiterm s. *)

Definition subst_form_conjunctive   (sigmaterm : ( fin ) -> term ) (s : form_conjunctive ) : form  :=
    match s return form  with
    | Conj  s0 s1 => Conj_  ((subst_form sigmaterm) s0) ((subst_form sigmaterm) s1)
    end.

Variable retract_subst_form : forall   (sigmaterm : ( fin ) -> term ) s, subst_form sigmaterm (inj s) = subst_form_conjunctive sigmaterm s.

Definition idSubst_form_conjunctive  (sigmaterm : ( fin ) -> term ) (Eqterm : forall x, sigmaterm x = (var_term ) x) (s : form_conjunctive ) : subst_form_conjunctive sigmaterm s = inj s :=
    match s return subst_form_conjunctive sigmaterm s = inj s with
    | Conj  s0 s1 => congr_Conj_ ((idSubst_form sigmaterm Eqterm) s0) ((idSubst_form sigmaterm Eqterm) s1)
    end.

Definition ext_form_conjunctive   (sigmaterm : ( fin ) -> term ) (tauterm : ( fin ) -> term ) (Eqterm : forall x, sigmaterm x = tauterm x) (s : form_conjunctive ) : subst_form_conjunctive sigmaterm s = subst_form_conjunctive tauterm s :=
    match s return subst_form_conjunctive sigmaterm s = subst_form_conjunctive tauterm s with
    | Conj  s0 s1 => congr_Conj_ ((ext_form sigmaterm tauterm Eqterm) s0) ((ext_form sigmaterm tauterm Eqterm) s1)
    end.

Definition compSubstSubst_form_conjunctive    (sigmaterm : ( fin ) -> term ) (tauterm : ( fin ) -> term ) (thetaterm : ( fin ) -> term ) (Eqterm : forall x, ((funcomp) (subst_term tauterm) sigmaterm) x = thetaterm x) (s : form_conjunctive ) : subst_form tauterm (subst_form_conjunctive sigmaterm s) = subst_form_conjunctive thetaterm s :=
    match s return subst_form tauterm (subst_form_conjunctive sigmaterm s) = subst_form_conjunctive thetaterm s with
    | Conj  s0 s1 => (eq_trans) (retract_subst_form (_) (Conj (_) (_))) (congr_Conj_ ((compSubstSubst_form sigmaterm tauterm thetaterm Eqterm) s0) ((compSubstSubst_form sigmaterm tauterm thetaterm Eqterm) s1))
    end.

Lemma instId_form_conjunctive  : subst_form_conjunctive (var_term ) = inj .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun x => idSubst_form_conjunctive (var_term ) (fun n => eq_refl) ((id) x))). Qed.

Lemma compComp_form_conjunctive    (sigmaterm : ( fin ) -> term ) (tauterm : ( fin ) -> term ) (s : form_conjunctive ) : subst_form tauterm (subst_form_conjunctive sigmaterm s) = subst_form_conjunctive ((funcomp) (subst_term tauterm) sigmaterm) s .
Proof. exact (compSubstSubst_form_conjunctive sigmaterm tauterm (_) (fun n => eq_refl) s). Qed.

Lemma compComp'_form_conjunctive    (sigmaterm : ( fin ) -> term ) (tauterm : ( fin ) -> term ) : (funcomp) (subst_form tauterm) (subst_form_conjunctive sigmaterm) = subst_form_conjunctive ((funcomp) (subst_term tauterm) sigmaterm) .
Proof. exact ((FunctionalExtensionality.functional_extensionality _ _ ) (fun n => compComp_form_conjunctive sigmaterm tauterm n)). Qed.

Definition isIn_form_form_conjunctive (s : form) (t : form_conjunctive) : Prop :=
  match t with
  | Conj t0 t1  => or (s = t0) (s = t1)
  end.

End form_conjunctive.


From Coq Require Import Psatz Arith List Program.Equality String.
From DanTrick Require Import ProofCompiler StackLangTheorems ImpVarMap DanImpHigherOrderRel ProofCompilerBase DanLogProp LogicProp ProofCompilerHelpers DanHoareWF DanLogHoare DanImpHigherOrderRelTheorems LogicTranslationBase LogicTranslationAdequate DanTrickLanguage.
Import ProofCompiler.Tests.

Local Open Scope string_scope.
Local Open Scope list_scope.
Local Open Scope dantrick_scope.

Lemma fold_left_is_reverse_stronger :
  forall (s other: ListSet.set string),
    ListSet.set_fold_left
      (fun (acc: list string) (x: string) => x :: acc)
      s
      other = rev s ++ other.
Proof.
  induction s; intros; simpl.
  - reflexivity.
  - erewrite IHs.
    rewrite <- app_assoc.
    rewrite StackSubstitution.cons_is_append_singleton_list.
    reflexivity.
Qed.

Lemma fold_left_is_reverse :
  forall (s: ListSet.set string),
    ListSet.set_fold_left
      (fun (acc: list string) (x: string) => x :: acc)
      s
      nil = rev s.
Proof.
  intros. remember (rev s) as revs.
  rewrite app_nil_end in Heqrevs.
  subst. eapply fold_left_is_reverse_stronger.
Qed.

Lemma set_fold_left_of_set_union_identity :
  forall (s: ListSet.set string),
    NoDup s ->
    s = ListSet.set_fold_left (fun (acc: list string) (x: string) => x :: acc)
                              (ListSet.set_union string_dec (ListSet.empty_set string) s) nil.
Proof.
  induction s; intros.
  - simpl. reflexivity.
  - invs H.
    pose proof (H3' := H3).
    eapply IHs in H3'.
    simpl.
    rewrite no_dup_set_add_is_append.
    + rewrite fold_left_is_reverse. rewrite rev_app_distr.
      simpl. rewrite nil_set_union_is_reverse.
      rewrite rev_involutive. reflexivity. eassumption.
    + rewrite nil_set_union_is_reverse.
      econstructor.
      eapply not_in_preserved_by_reverse in H2. eassumption.
      eapply nodup_preserved_by_reverse in H3. eassumption.
      eassumption.
Qed.

Lemma containment_disjunction :
  forall (x: DanTrickLanguage.ident) (setA setB: ListSet.set ident) (idents: list ident),
    NoDup idents ->
    NoDup setA ->
    NoDup setB ->
    In x idents ->
    idents =
      ListSet.set_fold_left
        (fun (acc : list string) (x : string) => x :: acc)
        (ListSet.set_union string_dec setA
                           setB) nil ->
    In x setA \/ In x setB.
Proof.
  induction setA; intros.
  - right. pose proof (fold_left_containment_helper).
    specialize (H4 (ListSet.set_union string_dec nil setB) x).
    rewrite nil_set_union_is_reverse in H4; [ | eassumption ].
    rewrite fold_left_is_reverse in H4.
    rewrite rev_involutive in H4.
    rewrite nil_set_union_is_reverse in H3; [ | eassumption ].
    rewrite fold_left_is_reverse in H3.
    rewrite rev_involutive in H3. rewrite H3 in H2. eassumption.
  - rewrite fold_left_is_reverse_stronger in H3.
    rewrite <- app_nil_end in H3.
    rewrite H3 in H2.
    eapply in_preserved_by_reverse in H2.
    eapply ListSet.set_union_iff in H2.
    eassumption.
Qed.

Ltac exclude_ridiculous :=
  match goal with
  | [ H: ?x <> ?x |- _ ] =>
      let Heq := fresh "Heq" in
      assert (Heq: x = x) by reflexivity;
      eapply H in Heq; invs Heq
  | [ H: ?x <> ?y, H': ?x = ?y |- _ ] =>
      eapply H in H'; invs H'
  | [ H: ?x <> ?y, H': ?y = ?x |- _ ] =>
      symmetry in H'; eapply H in H'; invs H'
  end.

Lemma in_list_means_exists_index :
  forall (idents: list ident) (x: ident),
    In x idents ->
    exists k, (one_index_opt x idents = S k).
Proof.
  induction idents; intros.
  - invs H.
  - invs H.
    + exists 0. simpl.
      destruct (string_dec x x) eqn:Eq.
      reflexivity.
      exclude_ridiculous.
    + pose proof (string_dec x a).
      destruct H1.
      * exists 0. rewrite e. simpl. destruct (string_dec a a).
        reflexivity.
        exclude_ridiculous.
      * eapply IHidents in H0. destruct H0 as (k & H0).
        exists (S k).
        simpl.
        destruct (string_dec a x) eqn:Heq.
        clear Heq.
        exclude_ridiculous.
        rewrite H0. reflexivity.
Defined.

Lemma free_vars_in_imp_alternate :
  forall (idents: list ident) (i: imp_Dan) (x: ident),
    In x idents ->
    idents = construct_trans i ->
    imp_has_variable x i.
Proof.
  intros.
  rewrite H0 in H. unfold construct_trans in H.
  rewrite fold_left_is_reverse in H. eapply in_preserved_by_reverse in H.
  eapply free_vars_in_imp_has_variable in H; [ eassumption | ereflexivity].
Defined.

Ltac prove_nodup_finite :=
  match goal with
  | [ |- NoDup (?a :: ?alist) ] =>
      let Hin := fresh "Hin" in
      econstructor; [unfold not; intros Hin; invs Hin | prove_nodup_finite ]
  | [ |- NoDup nil ] =>
      econstructor
  end.

Lemma second_wf_proof :
  forall (idents: list string)
    (index : nat) (x : StackLanguage.ident),
    0 <= index < Datatypes.length idents ->
    find_index_rel idents x (Some index) <->
      one_index_opt x idents = S index.
Proof.
  induction idents; intros index; induction index; split; intros.
  - invs H0.
  - simpl in H. invs H. invs H2.
  - invs H0.
  - invs H0.
  - invs H0.
    simpl. destruct (string_dec a a) eqn:Eqa; [ | exclude_ridiculous].
    reflexivity.
  - invs H0.
    destruct (string_dec a x) eqn:Eq.
    + subst. econstructor. reflexivity.
    + assert (one_index_opt x idents = 0).
      invs H2. reflexivity.
      unfold one_index_opt in H1.
      destruct idents. invs H1.
      destruct (string_dec s x) eqn:Eqs.
      invs H1.
      invs H1.
  - invs H0.
    simpl. destruct (string_dec a x); try exclude_ridiculous.
    f_equal.
    eapply IHidents.
    invs H. intuition.
    eassumption.
  - econstructor.
    simpl in H0. destruct (string_dec a x) eqn:Eqa.
    invs H0.
    unfold not; intros. symmetry in H1.  eapply n in H1. eassumption.
    simpl in H0. destruct (string_dec a x) eqn:Eqa.
    invs H0.
    invs H0. eapply IHidents.
    intuition. eassumption.
Defined.

Lemma well_formed_assign_param1 :
  imp_rec_rel (var_map_wf_wrt_imp ("z" :: nil)) ("z" <- PARAM_Dan 1).
Proof.
  pose proof (H := "z" = "z").
  econstructor. unfold_wf_imp; intros.
  * split; [ | split; [ | split]]; intros.
    -- econstructor. unfold not; intros. invs H0. econstructor.
    -- eapply second_wf_proof. eassumption.
    -- invs H0; [ | invs H1].
       exists 0. reflexivity.
    -- eapply free_vars_in_imp_alternate; eassumption.
  * econstructor. unfold_wf_aexp; intros.
    -- split; [ | split; [ | split ]]; intros.
       ++ prove_nodup_finite.
       ++ eapply second_wf_proof. eassumption.
       ++ eapply in_list_means_exists_index. eassumption.
       ++ eapply free_vars_in_imp_alternate; eassumption.
    -- simpl in H0. rewrite H0 in H1. invs H1.
    -- simpl in H0. rewrite H0 in H1. invs H1.
    -- simpl in H0. rewrite H0 in H1. invs H1.
    -- invs H0.
  * invs H0.
    -- eapply String.eqb_eq in H3. rewrite H3. econstructor. reflexivity.
    -- invs H3.
Qed.

Ltac prove_var_map_wf_wrt_bexp_no_vars_in_bexp :=
  unfold_wf_bexp; intros;
  [ | match goal with
      | [ H: ?idents = free_vars_bexp_src ?bexp,
            H': In ?x ?idents |- _ ] =>
          simpl in H;
          rewrite H in H';
          invs H'
      end .. ];
  split; [ | split; [ | split ]]; intros;
  [ prove_nodup_finite
  | eapply second_wf_proof; eassumption
  | eapply in_list_means_exists_index; eassumption
  | eapply free_vars_in_imp_alternate; eassumption ].

Ltac prove_var_map_wf_wrt_aexp_no_vars_in_aexp :=
  unfold_wf_aexp; intros;
  [ | match goal with
      | [ H: ?idents = free_vars_aexp_src ?bexp,
            H': In ?x ?idents |- _ ] =>
          simpl in H;
          rewrite H in H';
          invs H'
      end .. ];
  split; [ | split; [ | split ]]; intros;
  [ prove_nodup_finite
  | eapply second_wf_proof; eassumption
  | eapply in_list_means_exists_index; eassumption
  | eapply free_vars_in_imp_alternate; eassumption ].