  Axiom Tf1_equality  : forall {T U:Type} (f g:T->U),
    (forall x, f x = g x) -> f = g.

  Axiom Tf2_equality : forall {T U V:Type} (f g:T->U->V),
    (forall x y, f x y = g x y) -> f = g.

  Definition idempotent {T:Type} (f:T->T) :=
    forall x, f x =  f (f x).

  Definition involutive {T:Type} (f:T->T) :=
     forall x, f (f x) = x.

  Definition injective {T U:Type} (f:T->U) :=
    forall x y, f x = f y -> x = y.

  Definition surjective {T U:Type} (f:T-> U) :=
    forall y, exists x, f x = y.

  Definition bijective {T U:Type} (f:T->U) :=
    injective f /\ surjective f.

  Definition periodic {T U:Type} (f:T->U) (Tplus:T->T->T) :=
    exists P, forall x, f(Tplus x P) = f x.

  Definition commutative {T:Type} (f:T->T->T) :=
    forall x y, f x y = f y x.

  Definition associative {T:Type} (f:T->T->T) :=
    forall x y z, f x (f y z) = f (f x y) z.

  Definition distributive_r {T:Type} (f g:T->T->T) :=
    forall x y z, f (g x y) z = f (g x z) (g y z).

  Definition distributive_l {T:Type} (f g:T->T->T) :=
    forall x y z, f z (g x y) = f (g z x) (g z y).

  Definition neutral {T:Type} (Top:T->T->T)(e:T) :=
    forall x, Top x e = x.

  Definition cancel {T:Type} (Top:T->T->T) (e:T) :=
    forall x, Top x e = e.

  Definition even {T:Type} (f:T->T) (Topp:T->T) :=
    forall x, f (Topp x) = f x.

  Definition odd {T:Type} (f:T->T) (Topp:T->T) :=
    forall x, f (Topp x) = Topp (f x).

  Definition monotonic {T U:Type} (f:T->U) (ordT:T->T->Prop) (ordU:U->U->Prop) :=
    forall x y, ordT x y -> ordU (f x) (f y).

  Definition between {T:Type} (R:T->T->Prop) x y z :=
    R x y /\ R y z.

  (* TODO: Check correctness *)
  Definition continuous {T U:Type}
      (RT:T->T->Prop) (RU:U->U->Prop)
      (Tzero:T) (Uzero:U)
      (Tminus:T->T->T) (Tplus:T->T->T)
      (Uminus:U->U->U) (Uplus:U->U->U)
      (f:T->U) (D:T->Prop) (x0:T) :=
    D x0 ->
    forall e, RU Uzero e -> (
      exists d, RT Tzero d -> (
        forall x, D x ->
          between RT (Tminus x0 d) x (Tplus x0 d) ->
          between RU (Uminus (f x0) e) (f x) (Uplus (f x0) e)
      )
    ).

  (* TODO: Check correctness *)
  Definition uniform_continuous {T U:Type}
      (RT:T->T->Prop) (RU:U->U->Prop)
      (Tzero:T) (Uzero:U)
      (Tminus:T->T->T) (Tplus:T->T->T)
      (Uminus:U->U->U) (Uplus:U->U->U)
      (f:T->U) (D:T->Prop) (x0:T) :=
    D x0 ->
    forall e, RU Uzero e -> (
      exists d, RT Tzero d -> (
        forall x y, D x -> D y ->
          (RT (Tminus x y) d /\ RT (Tminus y x) d) ->
          (RU (Uminus (f x) (f y)) e /\ RU (Uminus (f y) (f x)) e)
      )
    ).

  Definition reflexive {T:Type} (R:T->T->Prop) :=
    forall x, R x x.

  Definition irreflexive {T:Type} (R:T->T->Prop) :=
    forall x y, R x y -> R y x -> False.

  Definition symmetric {T:Type} (R:T->T->Prop) :=
    forall x y, R x y -> R y x.

  Definition transitive {T:Type} (R:T->T->Prop) :=
    forall x y z, R x y -> R y z -> R x z.

  Definition antisymmetric {T:Type} (R:T->T->Prop) :=
    forall x y, R x y -> R y x -> x = y.

  Definition equivalence {T:Type} (R:T->T->Prop) :=
    reflexive R  /\ symmetric R /\ transitive R.

  Definition identity (T:Type) (x:T) := x.

  Lemma Tidentity_bijective : forall (T:Type), bijective (identity T).
  Proof.
    intro T.
    red.
    split;red.
    {
      intros x y h.
      unfold identity in h.
      exact h.
    }
    {
      intro y.
      unfold identity.
      exists y.
      reflexivity.
    }
  Qed.

  Lemma Tf1_intro : forall {T U:Type} (f:T->U) x y, x = y -> f x = f y.
  Proof.
  intros T U f x y heq.
  subst y.
  reflexivity.
  Qed.

  Lemma Tf2_intro_r : forall {T U V:Type} {f:T->U->V} x y z, x = y -> f x z = f y z.
  Proof.
    intros T U V f x y z heq.
    subst y.
    reflexivity.
  Qed.

  Lemma Tf2_intro_l : forall {T U V:Type} {f:T->U->V} x y z, x = y -> f z x = f z y.
  Proof.
    intros T U V f x y z heq.
    subst y.
    reflexivity.
  Qed.

  Parameter A:Type.

  Parameter Aplus : A->A->A.
  Parameter Amult : A->A->A.

  Axiom Aplus_comm: commutative Aplus.
  Axiom Amult_comm: commutative Amult.
  Axiom Aplus_assoc: associative Aplus.
  Axiom Amult_assoc: associative Amult.

  Parameter Azero : A.
  Parameter Aone : A.

  Axiom Aplus_zero_l : forall x, Aplus Azero x = x.
  Axiom Amult_zero_l : forall x, Amult Azero x = Azero.
  Axiom Amult_one_l : forall x, Amult Aone x = x.

  Parameter Aopp : A->A.

  Axiom Aopp_cancel_r : forall x, Aplus x (Aopp x) = Azero.

  Parameter Ale : A->A->Prop.

  Axiom Aeq_neq : forall (x y:A), x = y \/ x <> y.
  Axiom Aeq_dec : forall (x y:A), sumbool (x=y) (x<>y).

  Axiom Ale_le : forall x y, Ale x y \/ Ale y x.
  Axiom Ale_dec : forall x y, sumbool (Ale x y) (Ale y x).

  Definition Alt x y := Ale x y /\ x <> y.

  Axiom Aplus_elim_r : forall x y z, Aplus x z = Aplus y z -> x = y.
  Axiom Amult_elim_r : forall x y z, Amult x z = Amult y z -> x = y.

  Lemma Aopp_cancel_l : forall x, Aplus (Aopp x) x = Azero.
  Proof.
    intro x.
    rewrite (Aplus_comm _ x).
    rewrite Aopp_cancel_r.
    reflexivity.
  Qed.

  Lemma Aplus_elim_l : forall x y z, Aplus z x = Aplus z y -> x = y.
  Proof.
    intros x y z heq.
    apply Aplus_elim_r with z.
    repeat rewrite (Aplus_comm _ z).
    exact heq.
  Qed.

  Lemma Amult_elim_l : forall x y z, Amult z x = Amult z y -> x = y.
  Proof.
    intros x y z heq.
    apply Amult_elim_r with z.
    repeat rewrite (Amult_comm _ z).
    exact heq.
  Qed.

  Lemma Aplus_intro_l : forall x y z, x = y -> Aplus x z = Aplus y z.
  Proof.
    intros x y z heq.
    apply Tf2_intro_r.
    assumption.
  Qed.

  Lemma Aplus_intro_r : forall x y z, x = y -> Aplus z x = Aplus z y.
  Proof.
    intros x y z heq.
    apply Tf2_intro_l.
    assumption.
  Qed.

  Lemma Amult_intro_l : forall x y z, x = y -> Amult x z = Amult y z.
  Proof.
    intros x y z heq.
    apply Tf2_intro_r.
    assumption.
  Qed.

  Lemma Amult_intro_r : forall x y z, x = y -> Amult z x = Amult z y.
  Proof.
    intros x y z heq.
    apply Tf2_intro_l.
    assumption.
  Qed.

  Lemma Aopp_intro : forall x y, x = y -> Aopp x = Aopp y.
  Proof.
    intros x y heq.
    apply Tf1_intro.
    assumption.
  Qed.

  Lemma Aplus_zero_r : forall x, Aplus x Azero = x.
  Proof.
    intro x. rewrite Aplus_comm. apply Aplus_zero_l.
  Qed.

  Lemma Amult_zero_r : forall x, Amult x Azero = Azero.
  Proof.
    intro x. rewrite Amult_comm. apply Amult_zero_l.
  Qed.

  Lemma Amult_one_r : forall x, Amult x Aone = x.
  Proof.
    intro x. rewrite Amult_comm. apply Amult_one_l.
  Qed.

  Lemma Ale_refl : forall x, Ale x x.
  Proof.
    intro x.
    assert (ha:=Ale_le x x ).
    destruct ha as [h|h].
    { exact h. }
    { exact h. }
  Qed.

  Lemma Aopp_involutive : involutive Aopp.
  Proof.
    red.
    intro x.
    Search Aopp.
    apply Aplus_elim_r with (Aopp x).
    rewrite Aopp_cancel_l.
    rewrite Aopp_cancel_r.
    reflexivity.
  Qed.


Require Import prosa.classic.util.all.
Require Import prosa.classic.model.arrival.basic.task prosa.classic.model.arrival.basic.job prosa.classic.model.priority
               prosa.classic.model.arrival.basic.task_arrival prosa.classic.model.arrival.basic.arrival_bounds.
Require Import prosa.classic.model.schedule.uni.schedule prosa.classic.model.schedule.uni.workload.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop div.

Module WorkloadBoundFP.

  Import Job SporadicTaskset UniprocessorSchedule Priority Workload
         TaskArrival ArrivalBounds.

  (* In this section, we define a bound for the workload of a single task
     under uniprocessor FP scheduling. *)
  Section SingleTask.

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

    (* Consider any task tsk that is to be scheduled in an interval of length delta. *)
    Variable tsk: Task.
    Variable delta: time.

    (* Based on the maximum number of jobs of tsk that can execute in the interval, ... *)
    Definition max_jobs := div_ceil delta (task_period tsk).

    (* ... we define the following workload bound for the task. *)
    Definition task_workload_bound_FP := max_jobs * task_cost tsk.

  End SingleTask.

  (* In this section, we define a bound for the workload of multiple tasks. *)
  Section AllTasks.

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

    (* Assume any FP policy. *)
    Variable higher_eq_priority: FP_policy Task.

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

    (* ...and let tsk be the task to be analyzed. *)
    Variable tsk: Task.

    (* Let delta be the length of the interval of interest. *)
    Variable delta: time.

    (* Recall the definition of higher-or-equal-priority task and
       the per-task workload bound for FP scheduling. *)
    Let is_hep_task tsk_other := higher_eq_priority tsk_other tsk.
    Let W tsk_other :=
      task_workload_bound_FP task_cost task_period tsk_other delta.

    (* Using the sum of individual workload bounds, we define the following bound
       for the total workload of tasks of higher-or-equal priority (with respect
       to tsk) in any interval of length delta. *)
    Definition total_workload_bound_fp :=
      \sum_(tsk_other <- ts | is_hep_task tsk_other) W tsk_other.

  End AllTasks.

  (* In this section, we prove some basic lemmas about the workload bound. *)
  Section BasicLemmas.

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

    (* Assume any FP policy. *)
    Variable higher_eq_priority: FP_policy Task.

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

    (* ...and let tsk be any task in ts. *)
    Variable tsk: Task.
    Hypothesis H_tsk_in_ts: tsk \in ts.

    (* Recall the workload bound for uniprocessor FP scheduling. *)
    Let workload_bound :=
      total_workload_bound_fp task_cost task_period higher_eq_priority ts tsk.

    (* In this section we prove that the workload bound in a time window of
       length (task_cost tsk) is as large as (task_cost tsk) time units.
       (This is an important initial condition for the response-time analysis.) *)
    Section NoSmallerThanCost.

      (* Assume that the priority order is reflexive. *)
      Hypothesis H_priority_is_reflexive: FP_is_reflexive higher_eq_priority.

      (* Assume that cost and period of the task are positive. *)
      Hypothesis H_cost_positive: task_cost tsk > 0.
      Hypothesis H_period_positive: task_period tsk > 0.

      (* We prove that the workload bound of an interval of size (task_cost tsk)
         cannot be smaller than (task_cost tsk). *)
      Lemma total_workload_bound_fp_ge_cost:
        workload_bound (task_cost tsk) >= task_cost tsk.
      Proof.
        rename H_priority_is_reflexive into REFL.
        unfold workload_bound, total_workload_bound_fp.
        rewrite big_mkcond (big_rem tsk) /=; last by done.
        rewrite REFL /task_workload_bound_FP.
        apply leq_trans with (n := max_jobs task_period tsk (task_cost tsk) * task_cost tsk);
          last by apply leq_addr.
        rewrite -{1}[task_cost tsk]mul1n leq_mul2r; apply/orP; right.
        by apply ceil_neq0.
      Qed.

    End NoSmallerThanCost.

    (* In this section, we prove that the workload bound is monotonically non-decreasing. *)
    Section NonDecreasing.

      (* Assume that the period of every task in the task set is positive. *)
      Hypothesis H_period_positive:
        forall tsk,
          tsk \in ts ->
          task_period tsk > 0.

      (* Then, the workload bound is a monotonically non-decreasing function.
         (This property is important for the fixed-point iteration.) *)
      Lemma total_workload_bound_fp_non_decreasing:
        forall delta1 delta2,
          delta1 <= delta2 ->
          workload_bound delta1 <= workload_bound delta2.
      Proof.
        unfold workload_bound, total_workload_bound_fp; intros d1 d2 LE.
        apply leq_sum_seq; intros tsk' IN HP.
        rewrite leq_mul2r; apply/orP; right.
        apply leq_divceil2r; last by done.
        by apply H_period_positive.
      Qed.

    End NonDecreasing.

  End BasicLemmas.

  (* In this section, we prove that any fixed point R = workload_bound R
     is indeed a workload bound for an interval of length R. *)
  Section ProofWorkloadBound.

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

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

    (* Let ts be any task set with valid task parameters. *)
    Variable ts: seq Task.
    Hypothesis H_valid_task_parameters:
      valid_sporadic_taskset task_cost task_period task_deadline ts.

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

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

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

    (* Assume that jobs arrived sporadically. *)
    Hypothesis H_sporadic_arrivals:
      sporadic_task_model task_period job_arrival job_task arr_seq.

    (* Let tsk be any task in ts. *)
    Variable tsk: Task.
    Hypothesis H_tsk_in_ts: tsk \in ts.

    (* Assume any fixed-priority policy. *)
    Variable higher_eq_priority: FP_policy Task.

    (* First, let's define some local names for clarity. *)
    Let arrivals_between := jobs_arrived_between arr_seq.
    Let hp_workload t1 t2:=
      workload_of_higher_or_equal_priority_tasks job_cost job_task (arrivals_between t1 t2)
                                                 higher_eq_priority tsk.
    Let workload_bound :=
      total_workload_bound_fp task_cost task_period higher_eq_priority ts tsk.

    (* Consider any R that is a fixed point of the following equation,
       i.e., the claimed workload bound is equal to the interval length. *)
    Variable R: time.
    Hypothesis H_fixed_point: R = workload_bound R.

    (* Then, we prove that R is indeed a workload bound. *)
    Lemma fp_workload_bound_holds:
      forall t,
        hp_workload t (t + R) <= R.
    Proof.
      have BOUND := sporadic_task_arrival_bound task_period job_arrival job_task arr_seq.
      feed_n 3 BOUND; try (by done).
      rename H_fixed_point into FIX, H_all_jobs_from_taskset into FROMTS,
             H_valid_job_parameters into JOBPARAMS,
             H_valid_task_parameters into PARAMS.
      unfold hp_workload, workload_of_higher_or_equal_priority_tasks,
             valid_sporadic_job, valid_realtime_job,
             valid_sporadic_taskset, is_valid_sporadic_task in *.
      intro t.
      rewrite {2}FIX /workload_bound /total_workload_bound_fp.
      set l := jobs_arrived_between arr_seq t (t + R).
      set hep := higher_eq_priority.
      apply leq_trans with (n := \sum_(tsk' <- ts | hep tsk' tsk)
                                  (\sum_(j0 <- l | job_task j0 == tsk') job_cost j0)).
      {
        have EXCHANGE := exchange_big_dep (fun x => hep (job_task x) tsk).
        rewrite EXCHANGE /=; last by move => tsk0 j0 HEP /eqP JOB0; rewrite JOB0.
        rewrite /workload_of_jobs -/l big_seq_cond [X in _ <= X]big_seq_cond.
        apply leq_sum; move => j0 /andP [IN0 HP0].
        rewrite big_mkcond (big_rem (job_task j0)) /=;
          first by rewrite HP0 andTb eq_refl; apply leq_addr.
        by apply in_arrivals_implies_arrived in IN0; apply FROMTS.
      }
      apply leq_sum_seq; intros tsk0 INtsk0 HP0.
      apply leq_trans with (n := num_arrivals_of_task job_task arr_seq
                                                      tsk0 t (t + R) * task_cost tsk0).
      {
        rewrite /num_arrivals_of_task -sum1_size big_distrl /= big_filter.
        apply leq_sum_seq; move => j0 IN0 /eqP EQ.
        rewrite -EQ mul1n.
        feed (JOBPARAMS j0); first by eapply in_arrivals_implies_arrived; eauto 1.
        by move: JOBPARAMS => [_ [LE _]].
      }
      rewrite /task_workload_bound_FP leq_mul2r; apply/orP; right.
      feed (BOUND t (t + R) tsk0); first by feed (PARAMS tsk0); last by des.
      by rewrite addKn in BOUND.
    Qed.

  End ProofWorkloadBound.

End WorkloadBoundFP.


(**
  * Relations
*)

Set Implicit Arguments.

Module Relation.
  Definition relation (A: Type) := A -> A -> Prop.

  Class Reflexive {A: Type}(R: relation A) :=
    Reflexivity: forall x: A, R x x.

  Class Symmetric {A: Type}(R: relation A) :=
    Symmetry: forall x y: A, R x y -> R y x.

  Class Transitive {A: Type}(R: relation A) :=
    Transitivity: forall x y z: A, R x y -> R y z -> R x z.

  Class Equivalence {A: Type}(eq: relation A) :=
    {
      equiv_eq:= eq;
      equiv_refl :> Reflexive equiv_eq;
      equiv_sym :> Symmetric equiv_eq;
      equiv_trans :> Transitive equiv_eq
    }.
  Notation "A == B" := (equiv_eq A B) (at level 90, no associativity).

  Class Antisymmetric {A: Type}{eq: relation A}(equiv: Equivalence eq)(R: relation A) :=
    Antisymmetry: forall x y: A, R x y -> R y x -> x == y.

  Class PartialOrder {A: Type}{eq: relation A}(equiv: Equivalence eq) :=
    {
      pord_ord: relation A;
      pord_refl:> Reflexive pord_ord;
      pord_trans:> Transitive pord_ord;
      pord_antisym:> Antisymmetric equiv pord_ord;

      pord_refl_eq:
        forall x y: A,
          x == y -> pord_ord x y
    }.

  Notation "A <= B" := (pord_ord A B) (at level 70, no associativity).

  Section eq_Equivalence.
    Require Import List.

    Program Instance eq_Reflexive (A: Type): Reflexive (eq (A:=A)).

    Program Instance eq_Symmetric (A: Type): Symmetric (eq (A:=A)).

    Program Instance eq_Transitive (A: Type): Transitive (eq (A:=A)).

    Program Instance eq_Equivalence (A: Type): Equivalence (eq (A:=A)).
  End eq_Equivalence.

  Section iff_Equivalence.
    Program Instance iff_Reflexive: Reflexive iff.
    Next Obligation.
      tauto.
    Qed.

    Program Instance iff_Symmetric: Symmetric iff.
    Next Obligation.
      tauto.
    Qed.

    Program Instance iff_Transitive: Transitive iff.
    Next Obligation.
      tauto.
    Qed.

    Program Instance iff_Equivalence: Equivalence iff | 100.

  End iff_Equivalence.

End Relation.


Require Import Arith.

Fixpoint sum_odd(n:nat) : nat :=
  match n with
  | O => O
  | S m => 1 + m + m + sum_odd m
  end.

Goal forall n, sum_odd n = n * n.
Proof.
  intros.
  induction n.
  simpl.
  reflexivity.
  simpl.
  rewrite IHn.
  ring.
Qed.


(* Cantor's pairing function. *)

From set_theory Require Import lib fn.

(* Quadratic form of Cantors pairing function *)
Definition π (k : nat * nat) :=
  let k1 := fst k in
  let k2 := snd k in
  div2 ((k1 + k2) * (k1 + k2 + 1)) + k2.

(* Step mapping *)
Definition π_step (k : nat * nat) : nat * nat :=
  match k with
  | (0, y) => (S y, 0)
  | (S x, y) => (x, S y)
  end.

(* Compute stepped inversion of π. *)
Definition π_inv n := (π_step ↑ n) (0, 0).

Example π_47_32 : π (47, 32) = 3192.
Proof. now lazy. Qed.

Example π_inv_3192 : π_inv 3192 = (47, 32).
Proof. now lazy. Qed.

Lemma π_inv_succ n : π_inv (S n) = π_step (π_inv n).
Proof. easy. Qed.

Lemma π_steps_diagonal k1 k2 n :
  π_inv n = (k1, 0) -> k2 <= k1 -> π_inv (n + k2) = (k1 - k2, k2).
Proof.
unfold π_inv. induction k2; intros.
now rewrite add_0_r, sub_0_r.
apply IHk2 in H. rewrite add_succ_r; simpl. rewrite H.
destruct k1. lia. rewrite sub_succ_l; simpl. easy. all: lia.
Qed.

Lemma π_steps_axis k1 :
  ∃n, π_inv n = (k1, 0).
Proof.
induction k1. now exists 0.
destruct IHk1 as [m Hm]. exists (S (m + k1)).
erewrite π_inv_succ, π_steps_diagonal. 2: apply Hm.
rewrite sub_diag. all: easy.
Qed.

(* π_inv ranges over the entire set of pairs. *)
Theorem π_steps_range k :
  ∃n, π_inv n = k.
Proof.
destruct k as [k1 k2]. destruct (π_steps_axis (k1 + k2)) as [n Hn].
exists (n + k2). erewrite π_steps_diagonal. 2: apply Hn.
now rewrite add_sub. lia.
Qed.

Lemma div2_cancel m n :
  div2 (m + n * 2) = div2 m + n.
Proof.
rewrite div2_div, div_add, <-div2_div. all: easy.
Qed.

(* π is the inverse of π_inv. *)
Theorem π_π_inv_id n :
  π (π_inv n) = n.
Proof.
unfold π_inv. induction n. easy. simpl.
remember ((π_step ↑ n) (0, 0)) as k. rewrite <-IHn.
destruct k as [k0 k1], k0, k1; unfold π; simpl; rewrite ?add_0_r. easy.
(* Simplify div2 match. *)
1: replace (k1 + 1 + k1 * S (k1 + 1))
      with (S (k1*k1 + 3*k1)) by lia.
2: replace (k0 + 1 + k0 * S (k0 + 1))
      with (S (k0*k0 + 3*k0)) by lia.
3: replace (k0 + S k1 + 1 + (k0 + S k1) * S (k0 + S k1 + 1))
      with (S (k0*k0 + k1*k1 + 2*k0*k1 + 5*k0 + 5*k1 + 2*2)) by lia.
(* Simplify other side *)
1: replace (k1 + 1 + S (S (k1 + 1 + k1 * S (S (k1 + 1)))))
      with (k1 * k1 + 3 * k1 + (k1 + 2)*2) by lia.
2: replace ((k0 + 1) * (k0 + 1 + 1))
      with (k0*k0 + 3*k0 + 1*2) by lia.
3: replace ((k0 + S (S k1)) * (k0 + S (S k1) + 1))
      with (k0*k0 + k1*k1 + 2*k0*k1 + 5*k0 + 5*k1 + 3*2) by lia.
(* Simplify div2 and finish. *)
all: rewrite ?div2_cancel; lia.
Qed.

(* π_inv is the inverse of π. *)
Corollary π_inv_π_id k :
  π_inv (π k) = k.
Proof.
destruct (π_steps_range k).
now rewrite <-H, π_π_inv_id.
Qed.

Corollary π_bijective : Bijective π.
Proof. exists π_inv; split. apply π_inv_π_id. apply π_π_inv_id. Qed.

Corollary π_inv_bijective : Bijective π_inv.
Proof. exists π; split. apply π_π_inv_id. apply π_inv_π_id. Qed.


Require Import ZArith.

Definition INC : Z := 1.

Module divsteps.

Record State : Set :=
 { delta : Z
 ; f : Z
 ; g : Z
 ; d : Z
 ; e : Z
 ; modulus : Z
 }.

Definition init f g :=
{| delta := 1
 ; f := f
 ; g := g
 ; d := 0
 ; e := 1
 ; modulus := f
 |}.

Section Step.

Let div2M (M x : Z) : Z :=
 (if Z.odd x then x + M else x) / 2.

Definition step (st : State) : State :=
if Z.even (g st)
  then {| delta := INC + delta st
        ; f := f st
        ; g := g st / 2
        ; d := d st
        ; e := div2M (modulus st) (e st)
        ; modulus := modulus st
        |}
  else if (0 <? delta st)%Z
         then {| delta := INC - delta st
               ; f := g st
               ; g := (g st - f st) / 2
               ; d := e st
               ; e := div2M (modulus st) (e st - d st)
               ; modulus := modulus st
               |}
         else {| delta := INC + delta st
               ; f := f st
               ; g := (g st + f st) / 2
               ; d := d st
               ; e := div2M (modulus st) (e st + d st)
               ; modulus := modulus st
               |}.

Lemma modulus_step : forall st, modulus (step st) = modulus st.
Proof.
intros [delta f g d e modulus].
unfold step.
cbn -[Z.ltb Z.add Z.sub] in *.
case (Z.even g) eqn:Hg;[|case (0 <? delta)%Z];auto.
Qed.

Lemma odd_step : forall st, Z.Odd (f st) ->
   Z.Odd (f (step st)).
Proof.
intros [delta f g] Hf.
unfold step.
cbn -[Z.ltb Z.add Z.sub] in *.
case (Z.even g) eqn:Hg;[|case (0 <? delta)%Z];auto.
simpl.
rewrite <- Z.odd_spec, Zodd_even_bool, Hg.
reflexivity.
Qed.

Lemma zero_step : forall st, g st = 0%Z ->
   g (step st) = 0%Z.
Proof.
intros [delta f g]; simpl.
intros ->.
reflexivity.
Qed.

Lemma d_zero_spec : forall (n:nat) st,
  g st = 0%Z ->
  d (Nat.iter n step st) = d st.
Proof.
intros n [delta f g d e M]; simpl.
set (st := Build_State _ _ _ _ _ _).
intros ->.
cut (divsteps.g (Nat.iter n step st) = 0%Z /\ divsteps.d (Nat.iter n step st) = d).
 tauto.
induction n; auto.
simpl.
destruct IHn as [IHn1 IHn2].
split;auto using zero_step.
unfold step at 1.
rewrite IHn1.
assumption.
Qed.

Definition gcd (st : State) : Z :=
  Z.gcd (f st) (g st).

Lemma gcd_step : forall st, Z.Odd (f st) ->
  gcd (step st) = gcd st.
Proof.
assert (Hgcd : forall f g, Z.Odd f -> Z.Even g -> Z.gcd f (g / 2) = Z.gcd f g).
  intros f g Hf Hg.
  rewrite <- Zdiv2_div.
  replace g with (2 * Z.div2 g)%Z at 2 by
   (symmetry;
    apply Zeven_div2;
    rewrite Zeven_equiv;
    assumption).
  generalize (Z.div2 g); intros g'.
  symmetry.
  apply Znumtheory.Zis_gcd_gcd;[apply Z.gcd_nonneg|].
  constructor;[apply Z.gcd_divide_l|apply Z.divide_mul_r; apply Z.gcd_divide_r|].
  intros x Hxf Hxg'.
  apply Z.gcd_greatest; auto.
  apply Znumtheory.Gauss with 2%Z; auto.
  apply Znumtheory.rel_prime_sym.
  apply Znumtheory.prime_rel_prime;[apply Znumtheory.prime_2|].
  intros H2x.
  apply Z.Even_Odd_False with f; auto.
  rewrite <-Zeven_equiv, Zeven_ex_iff.
  exists (f / 2)%Z.
  apply Znumtheory.Zdivide_Zdiv_eq; auto with *.
  apply Z.divide_transitive with x; auto.
intros [delta f g] Hf.
unfold step, gcd.
cbn -[Z.ltb Z.add Z.sub] in *.
case (Z.even g) eqn:Hg;[|case (0 <? delta)%Z];cbn -[Z.add Z.sub].
* rewrite Z.even_spec in Hg.
  apply Hgcd; auto.
* rewrite (Z.gcd_comm f g), <- (Z.gcd_sub_diag_r g f).
  replace (f - g)%Z with (-(g - f))%Z by ring.
  rewrite Z.gcd_opp_r.
  apply Hgcd;
  [ rewrite <- Z.odd_spec, <- Z.negb_even, Hg; reflexivity
  | rewrite <- Z.odd_spec in Hf;
    rewrite <- Z.even_spec, Z.even_sub, Hg, Zeven.Zeven_odd_bool, Hf
  ]; reflexivity.
* rewrite <- (Z.gcd_add_diag_r f g).
  apply Hgcd; auto.
  rewrite <- Z.odd_spec in Hf.
  rewrite <- Z.even_spec, Z.even_add, Hg, Zeven.Zeven_odd_bool, Hf.
  reflexivity.
Qed.

Lemma gcd_spec : forall (n:nat) st,
  Z.Odd (f st) ->
  g (Nat.iter n step st) = 0%Z ->
  Znumtheory.Zis_gcd (f st) (g st) (f (Nat.iter n step st)).
Proof.
intros n [delta f g] Hf Hg; simpl in *.
set (d := divsteps.f _).
cut (Znumtheory.Zis_gcd f g (Z.abs d) /\ Z.Odd d).
  destruct (Z.abs_eq_or_opp d) as [-> | ->];intros [H _];[auto|].
  replace d with (- - d)%Z by ring.
  auto using Znumtheory.Zis_gcd_sym, Znumtheory.Zis_gcd_opp.
rewrite <- Z.gcd_0_r, <- Hg.
clear Hg.
induction n;[auto using Znumtheory.Zgcd_is_gcd|].
destruct IHn as [IHn1 IHn2].
split;[|apply odd_step; auto].
unfold d; simpl.
set (st' := (Nat.iter n _ _ )) in *.
fold (gcd (step st')).
rewrite (gcd_step st'); auto.
Qed.

Let modulo_invariant (x : Z) (st : State) :=
 eqm (modulus st) (f st) (d st * x) /\
 eqm (modulus st) (g st) (e st * x).

Definition inv2M (M : Z) : Z :=
 let 'Znumtheory.Euclid_intro _ _ u _ d _ _ := Znumtheory.euclid 2 M in (d*u).

Lemma mul_inv2M : forall M, Z.Odd M -> eqm M (inv2M M * 2) 1.
Proof.
intros M HM.
unfold inv2M.
destruct (Znumtheory.euclid 2 M) as [u v d Hd Hgcd].
assert (H : Znumtheory.rel_prime 2 M).
 apply Znumtheory.prime_rel_prime.
  apply Znumtheory.prime_2.
 intros Heven.
 apply (Zeven_not_Zodd M).
 rewrite Znumtheory.Zdivide_Zdiv_eq with 2%Z M; auto with *.
  apply Zeven_2p.
 apply Zodd_equiv; auto.
destruct (Znumtheory.Zis_gcd_uniqueness_apart_sign _ _ _ _ Hgcd H) as [Heq|Heq];
 rewrite Heq in *;
[|apply (f_equal Z.opp) in Hd;rewrite Z.opp_involutive in Hd;
  replace (- (u * 2 + v * M))%Z with (- u*2 + (-v) * M)%Z in Hd by ring];
 rewrite <- Hd at 2;
 unfold eqm;
 rewrite <- Zplus_mod_idemp_r, <- (Zmult_mod_idemp_r M), Z_mod_same_full,
         Z.mul_0_r, Z.add_0_r;
 f_equal.
ring.
Qed.

Lemma mul_inv2M_even : forall M x, Z.Odd M -> Z.Even x ->
 eqm M (x / 2) (inv2M M * x).
Proof.
intros M x HM Hx.
rewrite <- Z.div2_div.
rewrite (Zeven_div2 x) at 2; [|apply Zeven_equiv;auto].
rewrite Zmult_assoc.
replace (Z.div2 x) with (1*Z.div2 x)%Z at 1 by ring.
apply Zmult_eqm;try reflexivity.
auto using eqm_sym, mul_inv2M.
Qed.

Lemma eqm_div2M : forall M x, Z.Odd M -> eqm M (div2M M x) (inv2M M * x).
Proof.
intros M x HM.
rewrite <- (Z.mul_1_l (div2M M x)).
apply eqm_trans with ((inv2M M * 2) * div2M M x)%Z.
 apply Zmult_eqm; try reflexivity.
 apply eqm_sym.
 apply mul_inv2M; auto.
rewrite <- Zmult_assoc.
apply Zmult_eqm; try reflexivity.
unfold div2M.
case (Z.odd x) eqn:Hx.
* apply Zodd_bool_iff in Hx.
  apply Zodd_equiv in HM.
  rewrite <- Zdiv2_div, <- Zeven_div2; auto using Zodd_plus_Zodd.
  unfold eqm; rewrite Zplus_mod.
  rewrite <- (Zmod_eqm M M), Z_mod_same_full, Z.add_0_r.
  apply Zmod_mod.
* apply (f_equal negb) in Hx.
  rewrite Z.negb_odd in Hx.
  apply Zeven_bool_iff in Hx.
  rewrite <- Zdiv2_div, <- Zeven_div2; auto.
  reflexivity.
Qed.

Lemma eqm_div2M' : forall M x y, Z.Odd M ->
 eqm M (inv2M M * (x * y)) (div2M M x * y).
Proof.
intros M x y HM.
rewrite Zmult_assoc.
apply Zmult_eqm;try reflexivity.
auto using eqm_div2M, eqm_sym.
Qed.

Lemma modulo_step : forall x st, Z.Odd (modulus st) -> Z.Odd (f st) ->
  modulo_invariant x st ->
  modulo_invariant x (step st).
Proof.
intros x [delta f g d e M] HM Hf [Heqf Heqg].
unfold modulo_invariant.
rewrite modulus_step.
simpl in *.
destruct (Z.eq_dec M 1%Z) as [->|HM1].
 unfold eqm.
 rewrite !Z.mod_1_r; auto with *.
destruct (Z.eq_dec M (-1)%Z) as [->|HM1'].
 unfold eqm.
 rewrite !(Z_mod_zero_opp_r _ _ (Z.mod_1_r _)); auto with *.
assert (HM0 : M <> 0%Z).
 rewrite <- Z.odd_spec in HM.
 intros HM0.
 rewrite HM0 in HM.
 discriminate.
assert (HM2 : (2 mod M)%Z <> 0%Z).
 rewrite <- Z.odd_spec in HM.
 intros H.
 apply Znumtheory.Zmod_divide in H; auto with *.
 apply Znumtheory.prime_divisors in H; auto using Znumtheory.prime_2.
 destruct H as [H|[H|[H|H]]]; try contradiction; rewrite H in HM; discriminate.
unfold step.
cbn -[Z.ltb Z.add Z.sub] in *.
case (Z.even g) eqn:Hg;[|case (0 <? delta)%Z];simpl;split;auto.
* apply Zeven_bool_iff in Hg.
  apply Zeven_equiv in Hg.
  eapply eqm_trans;[apply mul_inv2M_even;auto|].
  eapply eqm_trans;[|apply eqm_div2M';auto].
  apply Zmult_eqm;try reflexivity.
  assumption.
* apply (f_equal negb) in Hg.
  rewrite Z.negb_even in Hg.
  rewrite Zodd_bool_iff in Hg.
  apply Zodd_equiv in Hg.
  eapply eqm_trans;[apply mul_inv2M_even;auto|].
   apply Zeven_equiv.
   apply Zodd_plus_Zodd; apply Zodd_equiv; auto.
   apply Z.odd_spec.
   rewrite Z.odd_opp.
   apply Z.odd_spec.
   assumption.
  eapply eqm_trans;[|apply eqm_div2M';auto].
  apply Zmult_eqm;try reflexivity.
  replace ((e - d)*x)%Z with (e * x - d * x)%Z by ring.
  apply Zminus_eqm; auto.
* apply (f_equal negb) in Hg.
  rewrite Z.negb_even in Hg.
  rewrite Zodd_bool_iff in Hg.
  apply Zodd_equiv in Hg.
  eapply eqm_trans;[apply mul_inv2M_even;auto|].
   apply Zeven_equiv.
   apply Zodd_plus_Zodd; apply Zodd_equiv; auto.
  eapply eqm_trans;[|apply eqm_div2M';auto].
  apply Zmult_eqm;try reflexivity.
  replace ((e + d)*x)%Z with (e * x + d * x)%Z by ring.
  apply Zplus_eqm; auto.
Qed.

Lemma modulo_spec : forall (n:nat) st x,
  Z.Odd (modulus st) ->
  Z.Odd (f st) ->
  modulo_invariant x st ->
  Znumtheory.rel_prime (f st) (g st) ->
  let st' := (Nat.iter n step st) in
  g st' = 0%Z ->
  Z.abs (f st') = 1%Z /\
  eqm (modulus st) ((d st' * f st') * x) 1.
Proof.
intros n st x HM Hf Hinv Hprime st' Hg.
assert (HMeq : modulus st = modulus st').
 clear.
 induction n;try reflexivity.
 unfold st'.
 rewrite IHn.
 simpl.
 rewrite modulus_step.
 reflexivity.
assert (Hinv' : modulo_invariant x st').
 clear -HM Hf Hinv.
 cut (Z.Odd (modulus st') /\ (Z.Odd (f st') /\ modulo_invariant x st'));[tauto|].
 induction n; auto.
 destruct IHn as [IHn1 [IHn2 IHn3]].
 unfold st'.
 simpl.
 split;[rewrite modulus_step;auto|].
 split;[apply odd_step;auto|].
 apply modulo_step; auto.
destruct Hinv' as [Hinv' _].
rewrite (Zmult_comm (d st') _), <- Zmult_assoc.
rewrite <- HMeq in Hinv'.
assert (Hgcd := gcd_spec n st Hf Hg).
fold st' in Hgcd.
assert (H1 : Z.abs (f st') = 1%Z).
destruct (Znumtheory.Zis_gcd_uniqueness_apart_sign _ _ _ _ Hgcd Hprime) as [->| ->];
 auto.
split; auto.
change 1%Z with (1 * 1)%Z.
rewrite <- H1.
rewrite Z.abs_square.
apply eqm_sym.
apply Zmult_eqm; auto; reflexivity.
Qed.

Lemma modulo_init : forall f g, modulo_invariant g (init f g).
Proof.
intros f g.
split; unfold init; cbn -[Zmult]; unfold eqm.
* rewrite Z_mod_same_full, Z.mul_0_l, Zmod_0_l; reflexivity.
* rewrite Z.mul_1_l; reflexivity.
Qed.

End Step.
End divsteps.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import List.

Set Implicit Arguments.

Section Non_deterministic_Minsky_Machines.

  (* locations: index type for instructions, normally is nat *)

  Variables loc : Set.

  (* four instructions: STOPₙ, INCₙ, DECₙ and ZEROₙ (test)

     only two nat valued registers, indexed with bool
     ie true/α of which the values are denoted "a" below
     and false/β of which the values are denoted "b" below

     In any of the cases above, several instructions can
     co-exist at a given location, hence, no instruction
     can stop the computation by itself. This model is
     inherently no-deterministic.

     STOPₙ p:     accepts location p when α = β = 0
     INCₙ x p q:  at location p, x += 1 and jumps to location q
     DECₙ x p q:  at location p, x -= 1 (if possible) and jumps to location q
                  if x is already 0 then this instruction cannot compute
     ZEROₙ x p q: at location p, jumps to location q when x = 0

     *)

  Inductive ndmm2_instr : Set :=
    | ndmm2_stop    : loc  -> ndmm2_instr
    | ndmm2_inc     : bool -> loc -> loc -> ndmm2_instr
    | ndmm2_dec     : bool -> loc -> loc -> ndmm2_instr
    | ndmm2_zero    : bool -> loc -> loc -> ndmm2_instr.

  Notation α := true.
  Notation β := false.

  Notation STOPₙ := ndmm2_stop.
  Notation INCₙ  := ndmm2_inc.
  Notation DECₙ  := ndmm2_dec.
  Notation ZEROₙ := ndmm2_zero.

  Infix "∊" := In (at level 70).

  (* Programs are non-deterministic and described by
     a (finite) list of instructions

     Notice that eg

          [ STOPₙ 0 ; INCₙ α 0 4 ; DECₙ β 0 2 ]

     can both accept location 0 (if α = β = 0)
     or increment α and jump to location 4
     or decrement β (if not zero already) and jump to location 2

     Also repetitions and order do not matter hence these
     lists are viewed as finite sets, see ndmm2_accept_mono
     in ndMM2/ndmm2_utils.v
  *)

  Reserved Notation "Σ //ₙ a ⊕ b ⊦ u" (at level 70, no associativity).

  (* Σ //ₙ a ⊕ b ⊦ u denotes

         "Σ accepts the initial location u with values α:=a and β:=b"

    This big step semantics only describes the overall accepts predicate
    and does not capture output values.

   *)

  Inductive ndmm2_accept (Σ : list ndmm2_instr) : nat -> nat -> loc -> Prop :=

    | in_ndmm2a_stop  : forall p,         STOPₙ p ∊ Σ      ->  Σ //ₙ   0 ⊕   0 ⊦ p

    | in_ndmm2a_inc_a : forall a b p q,   INCₙ α p q ∊ Σ   ->  Σ //ₙ 1+a ⊕   b ⊦ q
                                                           ->  Σ //ₙ   a ⊕   b ⊦ p

    | in_ndmm2a_inc_b : forall a b p q,   INCₙ β p q ∊ Σ   ->  Σ //ₙ   a ⊕ 1+b ⊦ q
                                                           ->  Σ //ₙ   a ⊕   b ⊦ p

    | in_ndmm2a_dec_a : forall a b p q,   DECₙ α p q ∊ Σ   ->  Σ //ₙ   a ⊕   b ⊦ q
                                                           ->  Σ //ₙ 1+a ⊕   b ⊦ p

    | in_ndmm2a_dec_b : forall a b p q,   DECₙ β p q ∊ Σ   ->  Σ //ₙ   a ⊕   b ⊦ q
                                                           ->  Σ //ₙ   a ⊕ 1+b ⊦ p

    | in_ndmm2a_zero_a : forall b p q,    ZEROₙ α p q ∊ Σ  ->  Σ //ₙ   0 ⊕   b ⊦ q
                                                           ->  Σ //ₙ   0 ⊕   b ⊦ p

    | in_ndmm2a_zero_b : forall a p q,    ZEROₙ β p q ∊ Σ  ->  Σ //ₙ   a ⊕   0 ⊦ q
                                                           ->  Σ //ₙ   a ⊕   0 ⊦ p

  where "Σ //ₙ a ⊕ b ⊦ u" := (ndmm2_accept Σ a b u).

  (* A problem is a program, a start location and initial values for α/β *)

  Definition ndMM2_problem := { Σ : list ndmm2_instr & loc * (nat * nat) }%type.

  Definition ndMM2_ACCEPT (i : ndMM2_problem) : Prop :=
    match i with existT _ Σ (u,(a,b)) => Σ //ₙ a ⊕ b ⊦ u end.

End Non_deterministic_Minsky_Machines.


Require Import Coq.Arith.Minus.
Require Import Coq.Arith.EqNat.
Require Import Coq.Lists.List.
Require Import Coq.Bool.Bool.
Require Import Definitions.
Require Import Environment.
Require Import Keys.
Require Import Ascii.
Require Import Coq.ZArith.Znat.
Require Import Coq.Arith.Peano_dec.

Import EvalBigStep.
Import Expressions.
Import Effects.

Open Scope list_scope.

Fixpoint factorial (n : nat) : nat :=
match n with
  | O => S O
  | S n' => mult n (factorial n')
end.

Fixpoint fact (x : nat) : Exp :=
  match x with
    | 0 => pure (S 0)
    | S n => (pure x) Times (fact n)
  end.

Definition Fact : Exp
  := If (var "x") Equals (pure 0) Then pure 1
     Else ((var "x") Times (capp  (var "f")((var "x") Minus (pure 1)))).

Definition MuFact : Exp
  := mu "f" • lambda "x" • Fact.

Definition LetFactEff : Exp
  := Let (var "y") As (eapp (MuFact {{ Top }}) (pure 5 {{ Top }})) In (var "y").

Lemma e_rec_aux :
  forall (facts aacts bacts : Phi)
         (f x : ascii)
         (ef ea e': Exp)
         (v v' : Val)
         (env env': Env)
         (heap fheap aheap bheap : Heap)
         (acts : Phi),
    (heap, env, proj_c ef) ⇓ (fheap, Cls (env', Mu f x e'), facts) ->
    (fheap, env, proj_c ea) ⇓ (aheap, v, aacts) ->
    (aheap, update_rec_E (f, Cls (env', Mu f x e')) (x, v) env', e') ⇓ (bheap, v', bacts) ->
    acts = facts ++ aacts ++ bacts ->
    (heap, env, capp (ef) (ea)) ⇓ (bheap, v', acts).
Proof.
  intros. subst. eapply E_Capp; eauto.
Qed.

Lemma e_rec_eff_aux :
  forall (facts aacts bacts : Phi)
         (ef ea : Exp)
         (vef vea : EffSpec)
         (env: Env)
         (heap fheap aheap bheap : Heap)
         (acts : Phi)
         (spec : Val),
    (heap, env, proj_e ef) ⇓ (fheap, Eff vef, facts) ->
    (fheap, env, proj_e ea) ⇓ (aheap, Eff vea, aacts) ->
    acts = facts ++ aacts ++ bacts ->
    spec =  Eff (vef ⊕ vea) ->
    (heap, env, eapp (ef) (ea)) ⇓ (bheap, spec, acts).
Proof.
  intros. subst. eapply E_Eapp; eauto.
Qed.

Lemma e_false_aux :
  forall (cacts facts : Phi)
         (e e1 e2 : Exp)
         (v : Val)
         (env : Env)
         (heap cheap fheap : Heap)
         (b : bool) (acts : Phi),
    (heap, env, e) ⇓ (cheap, (Bit b), cacts) ->
    (cheap, env, e2) ⇓ (fheap, v, facts) ->
    b = false ->
    acts = cacts ++ facts ->
    (heap, env, If e Then e1 Else e2 {{ Top }} ) ⇓ (fheap, v, acts).
Proof.
  intros. subst.  eapply E_False; eauto.
Qed.

Lemma e_true_aux :
  forall (cacts facts : Phi)
         (e e1 e2 : Exp)
         (v : Val)
         (env : Env)
         (heap cheap theap : Heap)
         (b : bool) (acts : Phi),
    (heap, env, e) ⇓ (cheap, (Bit b), cacts) ->
    (cheap, env, e1) ⇓ (theap, v, facts) ->
    b = true ->
    acts = cacts ++ facts ->
    (heap, env, If e Then e1 Else e2 {{Top }} ) ⇓ (theap, v, acts).
Proof.
  intros. subst. eapply E_True; eauto.
Qed.

Hint Constructors Dynamic.
Hint Resolve R_same_key R_diff_key_2 EProofs.add_bst.

Lemma example :
  forall env heap,
    E.Raw.bst env ->
    Dynamic (heap, env, capp (mu "f" • lambda "x" • Fact {{ Top }} ) (pure 5 {{ Top }} ))
                 (heap, Num 120, nil).
Proof.
  intros env heap bst.
  assert (x_neq_f: "x"%char <> "f"%char) by (unfold not; intro H; inversion H).
  assert (f_neq_x: "f"%char <> "x"%char) by (unfold not; intro H; inversion H).
  replace (Num 120) with (Num (5 * (4 * (3 * (2 * (1 * 1)))))) by (simpl; reflexivity).
  unfold Fact.

  eapply e_rec_aux;
    repeat (eapply E_Abs || eapply E_Cnt || eapply E_Minus || (eapply E_Var; unfold find_E; eauto) || reflexivity ).
  unfold update_rec_E, find_E, fst, snd.
  eapply e_false_aux with (b := beq_nat 5 0); auto.
  eapply E_Beq; repeat (eapply E_Abs || eapply E_Cnt || eapply E_Minus || (eapply E_Var; unfold find_E; eauto) ).
  eapply E_Times; repeat (eapply E_Abs || eapply E_Cnt || eapply E_Minus || (eapply E_Var; unfold find_E; eauto) ).

  eapply e_rec_aux;
    repeat (eapply E_Abs || eapply E_Cnt || eapply E_Minus || (eapply E_Var; unfold find_E; eauto) || reflexivity).
  unfold update_rec_E, fst, snd.
  eapply e_false_aux with (b := beq_nat 4 0); auto.
  eapply E_Beq; repeat (eapply E_Abs || eapply E_Cnt || (eapply E_Var; unfold find_E; eauto)).
  eapply E_Times; repeat (eapply E_Abs || eapply E_Cnt || (eapply E_Var; unfold find_E; eauto)).

  eapply e_rec_aux;
    repeat (eapply E_Abs || eapply E_Cnt || eapply E_Minus ||  (eapply E_Var; unfold find_E; eauto) || reflexivity).
  unfold update_rec_E, fst, snd.
  eapply e_false_aux with (b := beq_nat 3 0); auto.
  eapply E_Beq; (eapply E_Abs || eapply E_Cnt || (eapply E_Var; unfold find_E; eauto)).
  eapply E_Times; repeat (eapply E_Abs || eapply E_Cnt ||  (eapply E_Var; unfold find_E; eauto)).

  eapply e_rec_aux;
    repeat (eapply E_Abs || eapply E_Cnt || eapply E_Minus || (eapply E_Var; unfold find_E; eauto) || reflexivity).
  unfold update_rec_E, fst, snd.
  eapply e_false_aux with (b := beq_nat 2 0);auto.
  eapply E_Beq; (eapply E_Abs || eapply E_Cnt || (eapply E_Var; unfold find_E; eauto)).
  eapply E_Times; repeat (eapply E_Abs || eapply E_Cnt ||  (eapply E_Var; unfold find_E; eauto)).

  eapply e_rec_aux;
    repeat (eapply E_Abs || eapply E_Cnt || eapply E_Minus || (eapply E_Var; unfold find_E; eauto) || reflexivity).
  unfold update_rec_E, fst, snd.
  eapply e_false_aux with (b := beq_nat 1 0);auto.
  eapply E_Beq; (eapply E_Abs || eapply E_Cnt || (eapply E_Var; unfold find_E; eauto)).
  eapply E_Times; repeat (eapply E_Abs || eapply E_Cnt ||  (eapply E_Var; unfold find_E; eauto)).

  eapply e_rec_aux;
   repeat (eapply E_Abs || eapply E_Cnt || eapply E_Minus || (eapply E_Var; unfold find_E; eauto) || reflexivity).
  unfold update_rec_E, fst, snd.
  eapply e_true_aux with (b := beq_nat 0 0);auto.
  eapply E_Beq; (eapply E_Abs || eapply E_Cnt || (eapply E_Var; unfold find_E; eauto)).

  simpl; reflexivity.
Qed.

Lemma example2 :
  forall env heap,
    E.Raw.bst env ->
    Dynamic (heap, env, LetFactEff)
            (heap, Eff Top, nil).
Proof.
  intros env heap bst.
  apply E_Let. unfold MuFact.

  eapply e_rec_eff_aux; simpl.
  - eapply E_Eff.
  - eapply E_Eff.
  - now simpl.
  - admit.
Qed.


From CoqAlgs Require Export Base.

Set Implicit Arguments.

(* Commutative rings with unit. *)
Class UCRing : Type :=
{
    carrier : Type;
    add : carrier -> carrier -> carrier;
    mul : carrier -> carrier -> carrier;
    zero : carrier;
    one : carrier;
    neg : carrier -> carrier;
    add_assoc: forall x y z : carrier, add (add x y) z = add x (add y z);
    add_comm : forall x y : carrier, add x y = add y x;
    zero_l : forall x : carrier, add zero x = x;
    zero_r : forall x : carrier, add x zero = x;
    neg_l : forall x : carrier, add (neg x) x = zero;
    neg_r : forall x : carrier, add x (neg x) = zero;
    mul_assoc: forall x y z : carrier, mul (mul x y) z = mul x (mul y z);
    mul_comm : forall x y : carrier, mul x y = mul y x;
    one_l : forall x : carrier, mul one x = x;
    one_r : forall x : carrier, mul x one = x;
    distr_l : forall x y z : carrier,
      mul x (add y z) = add (mul x y) (mul x z);
    distr_r : forall x y z : carrier,
      mul (add x y) z = add (mul x z) (mul y z);
}.

Notation "x + y" := (add x y).
Notation "x - y" := (add x (neg y)).
Notation "x * y" := (mul x y).
Notation "0" := zero.
Notation "1" := one.
Notation "- x" := (neg x).

Coercion carrier : UCRing >-> Sortclass.

(* Basic tactics for rewriting UCRing axioms. *)
#[global] Hint Rewrite @zero_l @zero_r @one_l @one_r @neg_l @neg_r : units.
#[global] Hint Rewrite @add_assoc @mul_assoc : assoc.
#[global] Hint Rewrite <- @add_assoc @mul_assoc : assoc'.
#[global] Hint Rewrite @add_comm @mul_comm : comm.
#[global] Hint Rewrite @distr_l @distr_r : distr.
#[global] Hint Rewrite <- @distr_l @distr_r : distr'.

Ltac rng := cbn; intros; autorewrite with units assoc distr; try congruence.
Ltac rng' := cbn; intros; autorewrite with units assoc' distr'; try congruence.

(* Basic lemmas. *)
Lemma add_cancel_l :
  forall (X : UCRing) (a b b' : X), a + b = a + b' -> b = b'.
Proof.
  intros.
  assert (-a + (a + b) = b); rng'.
  assert (-a + (a + b') = b'); rng'.
Qed.

Lemma add_cancel_r :
  forall (X : UCRing) (a a' b : X), a + b = a' + b -> a = a'.
Proof.
  intros. rewrite (add_comm a), (add_comm a') in H.
  eapply add_cancel_l. exact H.
Qed.

Lemma neg_neg :
  forall (X : UCRing) (x : X), --x = x.
Proof.
  intros.
  assert (-x + x = 0); rng.
  assert (-x + --x = 0); rng.
  eapply add_cancel_l. rewrite H0. rng.
Qed.

Lemma minus_a_a :
  forall (X : UCRing) (a : X), a - a = 0.
Proof. rng. Qed.

Lemma mul_0_l :
  forall (X : UCRing) (x : X), 0 * x = 0.
Proof.
  intros.
  assert (0 * x = (0 + 0) * x); rng.
  rewrite distr_r in H.
  assert (0 * x - 0 * x = 0 * x + (0 * x - 0 * x)).
    rewrite <- add_assoc, <- H. trivial.
    rewrite (minus_a_a X (0 * x)) in H0. rewrite zero_r in H0. rng.
Qed.

Lemma mul_0_r :
  forall (X : UCRing) (x : X), x * 0 = 0.
Proof.
  intros. rewrite mul_comm. apply mul_0_l.
Qed.

Lemma minus_zero :
  forall X : UCRing, -0 = 0.
Proof.
  intro.
  rewrite <- (neg_l zero) at 2.
  rewrite zero_r.
  reflexivity.
Qed.

Lemma minus_one_l :
  forall (X : UCRing) (a : X), -(1) * a = -a.
Proof.
  intros.
  apply (add_cancel_l X (1 * a)).
  rewrite <- distr_r, one_l, 2!minus_a_a, mul_0_l.
  reflexivity.
Qed.

Lemma minus_one_r :
  forall (X : UCRing) (a : X), a * -(1) = -a.
Proof.
  intros. rewrite mul_comm. apply minus_one_l.
Qed.

Lemma minus_one_x2 :
  forall X : UCRing, -(1) * -(1) = 1.
Proof.
  intros. rewrite minus_one_l, neg_neg. trivial.
Qed.

Lemma mul_minus_minus :
  forall (X : UCRing) (a b : X), -a * -b = a * b.
Proof.
  intros. rewrite <- (minus_one_l X a), <- (minus_one_l X b).
  rewrite <- mul_assoc, (mul_comm (-(1))).
  rewrite 2!mul_assoc, <- (mul_assoc (-(1))), minus_one_x2. rng.
Qed.

Lemma neg_add :
  forall (X : UCRing) (a b : X), -(a + b) = -a + -b.
Proof.
  intros.
  assert (-(a + b) + (a + b) = 0); rng.
  assert ((-a - b) + (a + b) = 0); rng.
    rewrite (add_comm a). rewrite <- (add_assoc (-b)). rewrite neg_l. rng.
    rewrite <- H0 in H. apply add_cancel_r in H. assumption.
Qed.

Lemma neg_mul :
  forall (X : UCRing) (a b : X), -(a * b) = (-a) * b.
Proof.
  intros. rewrite <- (minus_one_l X (a * b)), <- (minus_one_l X a).
  rewrite ?mul_assoc. trivial.
Qed.

Lemma neg_eq :
  forall (X : UCRing) (a b : X), -a = -b -> a = b.
Proof.
  intros. rewrite <- (neg_neg X a), <- (neg_neg X b).
  rewrite H. trivial.
Qed.

(* Hint base for lemma rewriting. *)
#[global] Hint Rewrite
  add_cancel_l add_cancel_r
  neg_neg neg_add neg_mul neg_eq
  mul_0_l mul_0_r mul_minus_minus
  minus_zero minus_one_l minus_one_r minus_one_x2
  : lemmas.


From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div.
From mathcomp Require Import ssrnum ssralg ssrint intdiv rat order.

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

Local Open Scope ring_scope.
Import GRing.Theory.
Import Order.Theory.
Import Num.Theory.

(** Theorem 1.2 First-order Diophantine Equation *)
Theorem first_diophantine (a b d g: int):
  a <> 0 -> b <> 0 -> gcdz a b = g -> (g %| d)%Z ->
  (exists (x y: int), (a * x) + (b * y) = d).
Proof.
  (* implementing infinite-descending method (book's method) is somewhat hard
     just use Bezout's coefficient.*)
  move=> neq_a0 neq_b0 gcd_ab.
  case: (egcdzP a b) => u v Huv _.
  case/dvdzP => h ->.
  exists (u * h), (v * h). subst.
  rewrite -Huv.
  rewrite mulrDr.
  rewrite mulrC -mulrA mulrC mulrA -mulrA.
  by rewrite [in a * u]mulrC [in b * v]mulrC [in v * b * h]mulrC.
Qed.

Theorem first_diophantine_false (a b d g: int):
  a <> 0 -> b <> 0 -> gcdz a b = g -> (g %| d)%Z = false ->
  ~(exists (x y: int), (a * x) + (b * y) = d).
Proof.
  move=> neq_a0 neq_b0 gcd_ab false_dvd.
  case=> x [y eq_xy].
  have dvd_gd: (g %| d)%Z.
  rewrite -eq_xy rpredD => //=; subst;  apply: dvdz_mulr;
                     by [apply dvdz_gcdl|apply dvdz_gcdr].
  move: dvd_gd.
  apply: (contraFnot _ (g %| d)%Z) => //=.
Qed.