Require Import Init.Init.
Require Import Relation.Relation_.

(* Function *)
Definition sing_val (R: J) := ∀ a, ∀ b1, ∀ b2, ⟨a, b1⟩ ∈ R → ⟨a, b2⟩ ∈ R
  → b1 = b2.
Definition sing_rot (R: J) := ∀ a1, ∀ a2, ∀ b, ⟨a1, b⟩ ∈ R → ⟨a2, b⟩ ∈ R
  → a1 = a2.

Definition fn    (F: J)   := rel F ∧ sing_val F.
Definition fmap (A B: J) := {s: 𝒫(A ⨉ B)| fn s ∧ dom(s) = A ∧ ran(s) ⊆ B}.
Notation   "A ↦ B"      := (fmap A B).

Definition surjs (A B: J) := {s: 𝒫(A ⨉ B)| fn s ∧ dom(s) = A ∧ ran(s) = B}.
Definition injs  (A B: J)
  := {s: 𝒫(A ⨉ B)| fn s ∧ dom(s) = A ∧ ran(s) ⊆ B ∧ (sing_rot s)}.
Definition bijs  (A B: J)
  := {s: 𝒫(A ⨉ B)| fn s ∧ dom(s) = A ∧ ran(s) = B ∧ (sing_rot s)}.

Notation "A ↦ˢ B" := (surjs A B).
Notation "A ↦ⁱ B" := (injs A B).
Notation "A ↦ᵇ B" := (bijs A B).

Definition restr (F A: J) := {x: F| ∃ a, ∃ b, ⟨a, b⟩ ∈ F ∧ x = ⟨a, b⟩ ∧ a ∈ A}.
Notation   "F ↾ A"        := (restr F A).

Definition image (F A: J) := ran(restr F A).
Notation   "F ⟦ A ⟧"      := (image F A).

Definition inv (R: J) := {x: ran(R) ⨉ dom(R)| ∃ a, ∃ b, ⟨a, b⟩ ∈ R ∧ x = ⟨b, a⟩}.
Notation   "R ⁻¹"     := (inv R).

Definition comp (F G: J)
  := {x: dom(F) ⨉ ran(G)| ∃ a, ∃ b, ∃ c, ⟨a, b⟩ ∈ F ∧ ⟨b, c⟩ ∈ G ∧ x = ⟨a, c⟩}.
Notation   "A ∘ B"       := (comp B A).

(* Function and Function Over *)
Lemma fn_i: ∀ F, rel F → sing_val F → fn F.
Proof.
  intros F P1 P2.
  apply (and_i P1 P2).
Qed.

Lemma fn_rel: ∀ F, fn F → rel F.
Proof.
  intros F [P1 _].
  apply P1.
Qed.

Lemma fn_sing_val: ∀ F, fn F → sing_val F.
Proof.
  intros F [_ P1].
  apply P1.
Qed.

Lemma fmap_fn: ∀ F, ∀ A, ∀ B, F ∈ A ↦ B → fn F.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [P2 _]].
  apply P2.
Qed.

Lemma fmap_dom: ∀ F, ∀ A, ∀ B, F ∈ A ↦ B → dom(F) = A.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [P2 _]]].
  apply P2.
Qed.

Lemma fmap_ran: ∀ F, ∀ A, ∀ B, F ∈ A ↦ B → ran(F) ⊆ B.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [_ P2]]].
  apply P2.
Qed.

Lemma fmap_i: ∀ F, ∀ A, ∀ B, fn F → dom(F) = A → ran(F) ⊆ B → F ∈ A ↦ B.
Proof.
  intros F A B P1 P2 P3.
  apply sub_i.
  + apply power_i.
    intros x Q1.
    destruct (fn_rel _ P1 _ Q1) as [a [b Q2]].
    pose (eq_cl (λ x, x ∈ F) Q2 Q1) as Q3.
    apply (eq_cr (λ x, x ∈ _) Q2).
    apply cp_i.
    - apply (eq_cl (λ x, _ ∈ x) P2).
      apply (dom_i _ _ _ Q3).
    - apply P3.
      apply (ran_i _ _ _ Q3).
  + repeat split.
    - apply P1.
    - apply P1.
    - apply P2.
    - apply P3.
Qed.

Lemma fmap_r: ∀ F, fn F → F ∈ dom(F) ↦ ran(F).
Proof.
  intros F P1.
  apply sub_i.
  + apply power_i.
    intros x Q1.
    destruct (fn_rel _ P1 _ Q1) as [a [b Q2]].
    pose (eq_cl (λ x, x ∈ F) Q2 Q1) as Q3.
    apply (eq_cr (λ x, x ∈ _) Q2).
    apply cp_i.
    - apply (dom_i _ _ _ Q3).
    - apply (ran_i _ _ _ Q3).
  + repeat split.
    - apply P1.
    - apply P1.
    - apply sub_r.
Qed.

Lemma fmap_ran_exten: ∀ F, ∀ A, ∀ B, ∀ B', F ∈ A ↦ B → B ⊆ B' → F ∈ A ↦ B'.
Proof.
  intros F A B B' P1 P2.
  apply fmap_i.
  + apply (fmap_fn _ _ _ P1).
  + apply (fmap_dom _ _ _ P1).
  + pose (fmap_ran _ _ _ P1) as Q1.
    apply (sub_t _ _ _ Q1 P2).
Qed.
(*----------------------------------------------------------------------------*)

(* Surjective *)
Lemma surj_fn: ∀ F, ∀ A, ∀ B, F ∈ A ↦ˢ B → fn F.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [P2 _]].
  apply P2.
Qed.

Lemma surj_dom: ∀ F, ∀ A, ∀ B, F ∈ A ↦ˢ B → dom(F) = A.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [P2 _]]].
  apply P2.
Qed.

Lemma surj_ran: ∀ F, ∀ A, ∀ B, F ∈ A ↦ˢ B → ran(F) = B.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [_ P2]]].
  apply P2.
Qed.

Lemma surj_fmap: ∀ F, ∀ A, ∀ B, F ∈ A ↦ˢ B → F ∈ A ↦ B.
Proof.
  intros F A B P1.
  apply fmap_i.
  + apply (surj_fn _ _ _ P1).
  + apply (surj_dom _ _ _ P1).
  + apply (eq_cr (λ x, x ⊆ _) (surj_ran _ _ _ P1)).
    apply sub_r.
Qed.

Lemma surj_i: ∀ F, ∀ A, ∀ B, fn F → dom(F) = A → ran(F) = B → F ∈ A ↦ˢ B.
Proof.
  intros F A B P1 P2 P3.
  apply sub_i.
  + apply power_i.
    intros x Q1.
    destruct (fn_rel _ P1 _ Q1) as [a [b Q2]].
    pose (eq_cl (λ x, x ∈ F) Q2 Q1) as Q3.
    apply (eq_cr (λ x, x ∈ _) Q2).
    apply cp_i.
    - apply (eq_cl (λ x, _ ∈ x) P2).
      apply (dom_i _ _ _ Q3).
    - apply (eq_cl (λ x, _ ∈ x) P3).
      apply (ran_i _ _ _ Q3).
  + repeat split.
    - apply P1.
    - apply P1.
    - apply P2.
    - apply P3.
Qed.

Lemma surj_i2: ∀ F, ∀ A, ∀ B, F ∈ A ↦ B → ran(F) = B → F ∈ A ↦ˢ B.
Proof.
  intros F A B P1 P2.
  apply surj_i.
  + apply (fmap_fn _ _ _ P1).
  + apply (fmap_dom _ _ _ P1).
  + apply P2.
Qed.

Lemma surj_r: ∀ F, fn F → F ∈ dom(F) ↦ˢ ran(F).
Proof.
  intros F P1.
  apply sub_i.
  + apply power_i.
    intros x Q1.
    destruct (fn_rel _ P1 _ Q1) as [a [b Q2]].
    pose (eq_cl (λ x, x ∈ F) Q2 Q1) as Q3.
    apply (eq_cr (λ x, x ∈ _) Q2).
    apply cp_i.
    - apply (dom_i _ _ _ Q3).
    - apply (ran_i _ _ _ Q3).
  + repeat split.
    - apply P1.
    - apply P1.
Qed.
(*----------------------------------------------------------------------------*)

(* Injective *)
Lemma inj_fn: ∀ F, ∀ A, ∀ B, F ∈ A ↦ⁱ B → fn F.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [P2 _]].
  apply P2.
Qed.

Lemma inj_dom: ∀ F, ∀ A, ∀ B, F ∈ A ↦ⁱ B → dom(F) = A.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [P2 _]]].
  apply P2.
Qed.

Lemma inj_ran: ∀ F, ∀ A, ∀ B, F ∈ A ↦ⁱ B → ran(F) ⊆ B.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [_ [P2 _]]]].
  apply P2.
Qed.

Lemma inj_sing_rot: ∀ F, ∀ A, ∀ B, F ∈ A ↦ⁱ B → sing_rot F.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [_ [_ P2]]]].
  apply P2.
Qed.

Lemma inj_fmap: ∀ F, ∀ A, ∀ B, F ∈ A ↦ⁱ B → F ∈ A ↦ B.
Proof.
  intros F A B P1.
  apply fmap_i.
  + apply (inj_fn _ _ _ P1).
  + apply (inj_dom _ _ _ P1).
  + apply (inj_ran _ _ _ P1).
Qed.

Lemma inj_i: ∀ F, ∀ A, ∀ B, fn F → dom(F) = A → ran(F) ⊆ B → sing_rot F
  → F ∈ A ↦ⁱ B.
Proof.
  intros F A B P1 P2 P3 P4.
  apply sub_i.
  + apply power_i.
    intros x Q1.
    destruct (fn_rel _ P1 _ Q1) as [a [b Q2]].
    pose (eq_cl (λ x, x ∈ F) Q2 Q1) as Q3.
    apply (eq_cr (λ x, x ∈ _) Q2).
    apply cp_i.
    - apply (eq_cl (λ x, _ ∈ x) P2).
      apply (dom_i _ _ _ Q3).
    - apply P3.
      apply (ran_i _ _ _ Q3).
  + repeat split.
    - apply P1.
    - apply P1.
    - apply P2.
    - apply P3.
    - apply P4.
Qed.

Lemma inj_i2: ∀ F, ∀ A, ∀ B, F ∈ A ↦ B → sing_rot F → F ∈ A ↦ⁱ B.
Proof.
  intros F A B P1 P2.
  apply inj_i.
  + apply (fmap_fn _ _ _ P1).
  + apply (fmap_dom _ _ _ P1).
  + apply (fmap_ran _ _ _ P1).
  + apply P2.
Qed.

Lemma inj_ran_exten: ∀ F, ∀ A, ∀ B, ∀ B', F ∈ A ↦ⁱ B → B ⊆ B' → F ∈ A ↦ⁱ B'.
Proof.
  intros F A B B' P1 P2.
  apply inj_i2.
  + apply (fmap_ran_exten _ _ _ _ (inj_fmap _ _ _ P1) P2).
  + apply (inj_sing_rot _ _ _ P1).
Qed.
(*----------------------------------------------------------------------------*)

(* Bijective *)
Lemma bij_fn: ∀ F, ∀ A, ∀ B, F ∈ A ↦ᵇ B → fn F.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [P2 _]].
  apply P2.
Qed.

Lemma bij_dom: ∀ F, ∀ A, ∀ B, F ∈ A ↦ᵇ B → dom(F) = A.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [P2 _]]].
  apply P2.
Qed.

Lemma bij_ran: ∀ F, ∀ A, ∀ B, F ∈ A ↦ᵇ B → ran(F) = B.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [_ [P2 _]]]].
  apply P2.
Qed.

Lemma bij_sing_rot: ∀ F, ∀ A, ∀ B, F ∈ A ↦ᵇ B → sing_rot F.
Proof.
  intros F A B P1.
  destruct (sub_e _ _ _ P1) as [_ [_ [_ [_ P2]]]].
  apply P2.
Qed.

Lemma bij_fmap: ∀ F, ∀ A, ∀ B, F ∈ A ↦ᵇ B → F ∈ A ↦ B.
Proof.
  intros F A B P1.
  apply fmap_i.
  + apply (bij_fn _ _ _ P1).
  + apply (bij_dom _ _ _ P1).
  + apply (eq_cr (λ x, x ⊆ _) (bij_ran _ _ _ P1)).
    apply sub_r.
Qed.

Lemma bij_i: ∀ F, ∀ A, ∀ B, fn F → dom(F) = A → ran(F) = B → sing_rot F
  → F ∈ A ↦ᵇ B.
Proof.
  intros F A B P1 P2 P3 P4.
  apply sub_i.
  + apply power_i.
    intros x Q1.
    destruct (fn_rel _ P1 _ Q1) as [a [b Q2]].
    pose (eq_cl (λ x, x ∈ F) Q2 Q1) as Q3.
    apply (eq_cr (λ x, x ∈ _) Q2).
    apply cp_i.
    - apply (eq_cl (λ x, _ ∈ x) P2).
      apply (dom_i _ _ _ Q3).
    - apply (eq_cl (λ x, _ ∈ x) P3).
      apply (ran_i _ _ _ Q3).
  + repeat split.
    - apply P1.
    - apply P1.
    - apply P2.
    - apply P3.
    - apply P4.
Qed.

Lemma bij_i2: ∀ F, ∀ A, ∀ B, F ∈ A ↦ B → ran(F) = B → sing_rot F → F ∈ A ↦ᵇ B.
Proof.
  intros F A B P1 P2 P3.
  apply bij_i.
  + apply (fmap_fn _ _ _ P1).
  + apply (fmap_dom _ _ _ P1).
  + apply P2.
  + apply P3.
Qed.

Lemma bij_i3: ∀ F, ∀ A, ∀ B, F ∈ A ↦ˢ B → F ∈ A ↦ⁱ B → F ∈ A ↦ᵇ B.
Proof.
  intros F A B P1 P2.
  apply bij_i.
  + apply (surj_fn _ _ _ P1).
  + apply (surj_dom _ _ _ P1).
  + apply (surj_ran _ _ _ P1).
  + apply (inj_sing_rot _ _ _ P2).
Qed.

Lemma bij_e: ∀ F, ∀ A, ∀ B, F ∈ A ↦ᵇ B → F ∈ A ↦ˢ B ∧ F ∈ A ↦ⁱ B.
Proof.
  intros F A B P1.
  split.
  + apply surj_i.
    - apply (bij_fn _ _ _ P1).
    - apply (bij_dom _ _ _ P1).
    - apply (bij_ran _ _ _ P1).
  + apply inj_i.
    - apply (bij_fn _ _ _ P1).
    - apply (bij_dom _ _ _ P1).
    - apply (eq_cr (λ x, x ⊆ _) (bij_ran _ _ _ P1)).
      apply sub_r.
    - apply (bij_sing_rot _ _ _ P1).
Qed.

Lemma inj_bij: ∀ F, ∀ A, ∀ B, F ∈ A ↦ⁱ B → F ∈ A ↦ᵇ ran(F).
Proof.
  intros F A B P1.
  apply bij_i.
  + apply (inj_fn _ _ _ P1).
  + apply (inj_dom _ _ _ P1).
  + apply eq_r.
  + apply (inj_sing_rot _ _ _ P1).
Qed.
(*----------------------------------------------------------------------------*)

(* Function Value *)
Theorem fval_exist: ∀ F, ∀ x, ∃ y, fn F → x ∈ dom(F) →
  ⟨x, y⟩ ∈ F ∧ (∀ z, ⟨x, z⟩ ∈ F → y = z).
Proof.
  intros F x.
  destruct (LEM (x ∈ dom(F))) as [P1 | P1].
  + destruct (dom_e _ _ P1) as [y P2].
    exists y.
    intros P3 P4.
    split.
    - apply P2.
    - intros z P5.
      destruct P3 as [_ P3].
      apply (P3 x y z P2 P5).
  + exists x.
    intros _ P2.
    apply (bot_e _ (P1 P2)).
Qed.

Definition fval (F x: J) := (ex_outl (fval_exist F x)).
Notation   "F [ x ]"     := (fval F x).

Lemma fval_e: ∀ F, ∀ x, ∀y, F[x] = y → fn F → x ∈ dom(F) →
  ⟨x, y⟩ ∈ F ∧ (∀ y2, ⟨x, y2⟩ ∈ F → y = y2).
Proof.
  intros F x y P1.
  apply (eq_cr (λ y, _ → _ → ⟨ x, y ⟩ ∈ F ∧ (∀ y2, _ → y = y2)) (eq_s P1)).
  apply (ex_outr (fval_exist F x)).
Qed.

Lemma fval_e1: ∀ F, ∀ x, ∀ y, F[x] = y → fn F → x ∈ dom(F) → ⟨x, y⟩ ∈ F.
Proof.
  intros F x y P1 P2 P3.
  destruct (fval_e F x y P1 P2 P3) as [P4 _].
  apply P4.
Qed.

Lemma fval_e2: ∀ F, ∀ x, ∀ y, F[x] = y → fn F → x ∈ dom(F) →
  (∀ y2, ⟨x, y2⟩ ∈ F → y = y2).
Proof.
  intros F x y P1 P2 P3.
  destruct (fval_e F x y P1 P2 P3) as [_ P4].
  apply P4.
Qed.

Lemma fval_i: ∀ F, ∀ x, ∀ y, fn F → ⟨x, y⟩ ∈ F → F[x] = y.
Proof.
  intros F x y P1 P2.
  destruct (ex_outr (fval_exist F x) P1 (dom_i _ _ _ P2)) as [_ P3].
  apply (P3 _ P2).
Qed.

Lemma fval_i2: ∀ F, ∀ x, fn F → x ∈ dom(F) → ⟨x, F[x]⟩ ∈ F.
Proof.
  intros F x P1 P2.
  destruct (dom_e _ _ P2) as [y P3].
  apply (eq_cr (λ y, ⟨x, y⟩ ∈ F) (fval_i _ _ _ P1 P3)).
  apply P3.
Qed.

Lemma fval_i3: ∀ F, ∀ A, ∀ B, ∀ x, F ∈ A ↦ B → x ∈ A → ⟨x, F[x]⟩ ∈ F.
Proof.
  intros F A B x P1 P2.
  apply fval_i2.
  + apply (fmap_fn _ _ _ P1).
  + apply (eq_cr _ (fmap_dom _ _ _ P1)).
    apply P2.
Qed.

Lemma fval_ran: ∀ F, ∀ x, fn F → x ∈ dom(F) → F[x] ∈ ran(F).
Proof.
  intros F x P1 P2.
  apply (ran_i _ x).
  apply (fval_i2 F x P1 P2).
Qed.

Lemma fval_codom: ∀ F, ∀ A, ∀ B, ∀ x, F ∈ A ↦ B → x ∈ A → F[x] ∈ B.
Proof.
  intros F A B x P1 P2.
  apply (fmap_ran _ _ _ P1).
  apply fval_ran.
  + apply (fmap_fn _ _ _ P1).
  + apply (eq_cr _ (fmap_dom _ _ _ P1)).
    apply P2.
Qed.

Lemma fval_inj: ∀ F, ∀ A, ∀ B, ∀ x, ∀ y, F ∈ A ↦ⁱ B → x ∈ A → y ∈ A
  → F[x] = F[y] → x = y.
Proof.
  intros F A B x y P1 P2 P3 P4.
  apply ((inj_sing_rot _ _ _ P1) _ _ (F[x])).
  + apply (fval_i2 _ _ (inj_fn _ _ _ P1)).
    apply (eq_cr _ (inj_dom _ _ _ P1) P2).
  + apply (eq_cr (λ x, ⟨y, x⟩ ∈ F) P4).
    apply (fval_i2 _ _ (inj_fn _ _ _ P1)).
    apply (eq_cr _ (inj_dom _ _ _ P1) P3).
Qed.

Lemma fval_sub: ∀ F, ∀ G, ∀ x, fn F → fn G → F ⊆ G → x ∈ dom(F) → F[x] = G[x].
Proof.
  intros F G x P1 P2 P3 P4.
  destruct (dom_e _ _ P4) as [y P5].
  apply (eq_cr (λ y, y = G[x]) (fval_i _ _ _ P1 P5)).
  apply (eq_cr (λ x, y = x) (fval_i _ _ _ P2 (P3 _ P5))).
  apply eq_r.
Qed.

Lemma fn_eq: ∀ F, ∀ G, fn F → fn G → dom(F) = dom(G)
  → (∀ x, x ∈ dom(F) → F[x] = G[x]) → F = G.
Proof.
  intros F G [P1 P2] [P3 P4] P5 P6.
  apply sub_a.
  split.
  + intros s P7.
    destruct (P1 _ P7) as [x [y P8]].
    apply (eq_cr (λ s, s ∈ G) P8).
    pose (eq_cl (λ s, s ∈ F) P8 P7) as P9.
    apply (eq_cl (λ y, ⟨x, y⟩ ∈ G) (fval_i _ _ _ (and_i P1 P2) P9)).
    apply (eq_cr (λ y, ⟨x, y⟩ ∈ G) (P6 _ (dom_i _ _ _ P9))).
    apply (fval_i2 _ _ (and_i P3 P4)).
    apply (eq_cl (λ y, x ∈ y) P5).
    apply (dom_i _ _ _ P9).
  + intros s P7.
    destruct (P3 _ P7) as [x [y P8]].
    apply (eq_cr (λ s, s ∈ F) P8).
    pose (eq_cl (λ s, s ∈ G) P8 P7) as P9.
    apply (eq_cl (λ y, ⟨x, y⟩ ∈ F) (fval_i _ _ _ (and_i P3 P4) P9)).
    apply (eq_cl (λ y, ⟨x, y⟩ ∈ F)
      (P6 _ (eq_cr (λ y, x ∈ y) P5 (dom_i _ _ _ P9)))).
    apply (fval_i2 _ _ (and_i P1 P2)).
    apply (eq_cr (λ y, x ∈ y) P5).
    apply (dom_i _ _ _ P9).
Qed.
(*----------------------------------------------------------------------------*)

(* Restriction *)
Theorem restr_i: ∀ x, ∀ y, ∀ F, ∀ A, ⟨x, y⟩ ∈ F → x ∈ A → ⟨x, y⟩ ∈ F↾A.
Proof.
  intros x y F A P1 P2.
  apply (sub_i _ _ _ P1).
  exists x.
  exists y.
  repeat split.
  + apply P1.
  + apply P2.
Qed.

Lemma restr_e: ∀ x, ∀ y, ∀ F, ∀ A, ⟨x, y⟩ ∈ F↾A → ⟨x, y⟩ ∈ F ∧ x ∈ A.
Proof.
  intros x y F A P1.
  destruct (sub_e _ _ _ P1) as [P2 [a [b [_ [P3 P4]]]]].
  split.
  + apply P2.
  + apply (eq_cr (λ x, x ∈ A) (opair_eq_el _ _ _ _ P3)).
    apply P4.
Qed.

Lemma restr_e2: ∀ s, ∀ F, ∀ A, s ∈ F↾A
  → ∃ x, ∃ y, ⟨x, y⟩ ∈ F ∧ s = ⟨x, y⟩ ∧ x ∈ A.
Proof.
  intros s F A P1.
  destruct (sub_e _ _ _ P1) as [_ P2].
  apply P2.
Qed.

Lemma restr_dom_e: ∀ x, ∀ F, ∀ A, x ∈ dom(F↾A) → x ∈ A ∧ ∃ y, ⟨x, y⟩ ∈ F.
Proof.
  intros x F A P1.
  destruct (dom_e _ _ P1) as [y P2].
  destruct (restr_e _ _ _ _ P2) as [P3 P4].
  split.
  + apply P4.
  + exists y.
    apply P3.
Qed.

Lemma restr_sub: ∀ F, ∀ A, ∀ B, A ⊆ B → F↾A ⊆ F↾B.
Proof.
  intros F A B P1 s P2.
  destruct (restr_e2 _ _ _ P2) as [x [y [P3 [P4 P5]]]].
  apply (eq_cr (λ x, x ∈ F↾B) P4).
  apply restr_i.
  + apply P3.
  + apply (P1 _ P5).
Qed.

Lemma restr_rel: ∀ F, ∀ A, rel (F↾A).
Proof.
  intros F A r P1.
  destruct (sub_e _ _ _ P1) as [_ [a [b [_ [P2 _]]]]].
  exists a.
  exists b.
  apply P2.
Qed.

Lemma restr_sing_val: ∀ F, ∀ A, sing_val F → sing_val (F↾A).
Proof.
  intros F A P1 x y1 y2 P2 P3.
  destruct (restr_e _ _ _ _ P2) as [P4 _].
  destruct (restr_e _ _ _ _ P3) as [P5 _].
  apply (P1 _ _ _ P4 P5).
Qed.

Lemma restr_sing_rot: ∀ F, ∀ A, sing_rot F → sing_rot (F↾A).
Proof.
  intros F A P1 x y1 y2 P2 P3.
  destruct (restr_e _ _ _ _ P2) as [P4 _].
  destruct (restr_e _ _ _ _ P3) as [P5 _].
  apply (P1 _ _ _ P4 P5).
Qed.

Lemma restr_fn: ∀ F, ∀ A, fn F → fn (F↾A).
Proof.
  intros F A [_ P1].
  split.
  + apply restr_rel.
  + apply (restr_sing_val _ _ P1).
Qed.

Lemma restr_dom: ∀ F, ∀ A, dom(F↾A) = dom(F) ∩ A.
Proof.
  intros F A.
  apply sub_a.
  split.
  + intros x P1.
    destruct (dom_e _ _ P1) as [y P2].
    destruct (restr_e _ _ _ _ P2) as [P3 P4].
    apply inter2_i.
    - apply (dom_i _ _ _ P3).
    - apply P4.
  + intros x P1.
    destruct (inter2_e _ _ _ P1) as [P2 P3].
    destruct (dom_e _ _ P2) as [y P4].
    apply (dom_i _ _ y).
    apply restr_i.
    - apply P4.
    - apply P3.
Qed.

Lemma sub_restr_eq: ∀ F, ∀ G, ∀ R, fn F → fn G → F ⊆ G → R ⊆ dom(F) → F↾R = G↾R.
Proof.
  intros F G R P1 P2 P3 P4.
  apply sub_a.
  split.
  + intros s P5.
    destruct (restr_e2 _ _ _ P5) as [x [y [P6 [P7 P8]]]].
    apply (eq_cr (λ s, s ∈ G↾R) P7).
    apply (restr_i).
    - apply (P3 _ P6).
    - apply P8.
  + intros s P5.
    destruct (restr_e2 _ _ _ P5) as [x [y [P6 [P7 P8]]]].
    apply (eq_cr (λ s, s ∈ F↾R) P7).
    apply (restr_i).
    - apply (eq_cl (λ y, ⟨x, y⟩ ∈ F) (fval_i _ _ _ P2 P6)).
      apply (eq_cl (λ y, ⟨x, y⟩ ∈ F) (fval_sub _ _ _ P1 P2 P3 (P4 _ P8))).
      apply (fval_i2 _ _ P1 (P4 _ P8)).
    - apply P8.
Qed.

Lemma restr_over: ∀ F, ∀ R, rel F → dom(F) ⊆ R → F↾R = F.
Proof.
  intros F R P1 P2.
  apply sub_a.
  split.
  + intros s P3.
    destruct (restr_e2 _ _ _ P3) as [x [y [P4 [P5 P6]]]].
    apply (eq_cr (λ x, x ∈ F) P5).
    apply P4.
  + intros s P3.
    destruct (P1 _ P3) as [x [y P4]].
    apply (eq_cr (λ x, x ∈ F↾R) P4).
    apply restr_i.
    - apply (eq_cl (λ x, x ∈ F) P4).
      apply P3.
    - pose (dom_i _ _ _ (eq_cl (λ x, x ∈ F) P4 P3)) as P5.
      apply (P2 _ P5).
Qed.

Lemma restr_bij: ∀ F, ∀ A, ∀ B, ∀ A', F ∈ A ↦ᵇ B → A' ⊆ A
  → F↾A' ∈ A' ↦ᵇ F⟦A'⟧.
Proof.
  intros F A B A' P1 P2.
  apply bij_i.
  + apply (restr_fn _ _ (bij_fn _ _ _ P1)).
  + apply (eq_cr (λ x, x = A') (restr_dom _ _)).
    apply inter2_absorb_r.
    apply (eq_cr (λ x, A' ⊆ x) (bij_dom _ _ _ P1) P2).
  + apply eq_r.
  + apply (restr_sing_rot _ _ (bij_sing_rot _ _ _ P1)).
Qed.

Lemma restr_fval: ∀ F, ∀ A, ∀ x, fn F → x ∈ dom(F) → x ∈ A → F[x] = (F↾A)[x].
Proof.
  intros F A x P1 P2 P3.
  apply eq_s.
  apply fval_i.
  + apply (restr_fn _ _ P1).
  + apply restr_i.
    - apply (fval_i2 _ _ P1 P2).
    - apply P3.
Qed.

Lemma restr_fval2: ∀ F, ∀ A, ∀ x, fn F → x ∈ dom(F) → x ∈ A
  → ⟨x, F[x]⟩ ∈ (F↾A).
Proof.
  intros F A x P1 P2 P3.
  apply restr_i.
  + apply (fval_i2 _ _ P1 P2).
  + apply P3.
Qed.
(*----------------------------------------------------------------------------*)

(* Image *)
Theorem image_i: ∀ y, ∀ F, ∀ A, (∃ x, ⟨x, y⟩ ∈ F ∧ x ∈ A) → y ∈ F⟦A⟧.
Proof.
  intros y F A [x [P1 P2]].
  apply (ran_i _ x).
  apply (restr_i _ _ _ _ P1 P2).
Qed.

Lemma image_i2: ∀ x, ∀ F, ∀ A, fn F → x ∈ dom(F) → x ∈ A → F[x] ∈ F⟦A⟧.
Proof.
  intros x F A P1 P2 P3.
  apply image_i.
  exists x.
  split.
  + apply (fval_i2 _ _ P1 P2).
  + apply P3.
Qed.

Lemma image_e: ∀ y, ∀ F, ∀ A, y ∈ F⟦A⟧ → (∃ x, ⟨x, y⟩ ∈ F ∧ x ∈ A).
Proof.
  intros y F A P1.
  destruct (ran_e _ _ P1) as [x P2].
  destruct (restr_e _ _ _ _ P2) as [P3 P4].
  exists x.
  split.
  + apply P3.
  + apply P4.
Qed.

Lemma image_e2: ∀ x, ∀ F, ∀ A, ∀ B, ∀ C, F ∈ A ↦ⁱ B → x ∈ A → F[x] ∈ F⟦C⟧
  → x ∈ C.
Proof.
  intros x F A B C P1 P2 P3.
  destruct (image_e _ _ _ P3) as [x' [P4 P5]].
  assert (x = x') as P6.
  { apply (fval_inj _ _ _ _ _ P1 P2).
    + apply (eq_cl (λ x, x' ∈ x) (inj_dom _ _ _ P1)).
      apply (dom_i _ _ _ P4).
    + apply eq_s.
      apply fval_i.
      - apply (inj_fn _ _ _ P1).
      - apply P4. }
  apply (eq_cr (λ x, x ∈ C) P6 P5).
Qed.

Lemma image_sub: ∀ F, ∀ A, ∀ B, A ⊆ B → F⟦A⟧ ⊆ F⟦B⟧.
Proof.
  intros F A B P1 y P2.
  destruct (image_e _ _ _ P2) as [x [P3 P4]].
  apply image_i.
  exists x.
  split.
  + apply P3.
  + apply (P1 _ P4).
Qed.

Lemma image_fmap: ∀ F, ∀ A, ∀ B, ∀ C, F ∈ A ↦ B → F⟦C⟧ ⊆ B.
Proof.
  intros F A B C P1 y P2.
  destruct (image_e _ _ _ P2) as [x [P3 P4]].
  apply (fmap_ran _ _ _ P1).
  apply (ran_i _ _ _ P3).
Qed.

(* 3K *)
Lemma image_union2: ∀ F, ∀ A, ∀ B, F⟦A ∪ B⟧ = F⟦A⟧ ∪ F⟦B⟧.
Proof.
  intros F A B.
  apply sub_a.
  split.
  + intros y P1.
    destruct (image_e _ _ _ P1) as [x [P2 P3]].
    destruct (union2_e _ _ _ P3) as [P4 | P4].
    - apply union2_il.
      apply image_i.
      exists x.
      apply (and_i P2 P4).
    - apply union2_ir.
      apply image_i.
      exists x.
      apply (and_i P2 P4).
  + intros y P2.
    apply image_i.
    destruct (union2_e _ _ _ P2) as [P3 | P3].
    - destruct (image_e _ _ _ P3) as [x [P4 P5]].
      exists x.
      split.
      * apply P4.
      * apply union2_il.
        apply P5.
    - destruct (image_e _ _ _ P3) as [x [P4 P5]].
      exists x.
      split.
      * apply P4.
      * apply union2_ir.
        apply P5.
Qed.

Lemma image_inter2: ∀ F, ∀ A, ∀ B, F⟦A ∩ B⟧ ⊆ F⟦A⟧ ∩ F⟦B⟧.
Proof.
  intros F A B y P1.
  destruct (image_e _ _ _ P1) as [x [P2 P3]].
  destruct (inter2_e _ _ _ P3) as [P4 P5].
  apply inter2_i.
  + apply image_i.
    exists x.
    apply (and_i P2 P4).
  + apply image_i.
    exists x.
    apply (and_i P2 P5).
Qed.

Lemma image_compl: ∀ F, ∀ A, ∀ B, (F⟦A⟧) \ (F⟦B⟧) ⊆ F⟦(A \ B)⟧.
Proof.
  intros F A B y P1.
  destruct (compl_e _ _ _ P1) as [P2 P3].
  apply image_i.
  destruct (image_e _ _ _ P2) as [x [P4 P5]].
  exists x.
  split.
  + apply P4.
  + apply (compl_i _ _ _ P5).
    intros P6.
    apply P3.
    apply image_i.
    exists x.
    apply (and_i P4 P6).
Qed.

Lemma image_ran: ∀ F, ∀ A, F⟦A⟧ ⊆ ran(F).
Proof.
  intros F A y P1.
  destruct (image_e _ _ _ P1) as [x [P2 P3]].
  apply (ran_i _ _ _ P2).
Qed.

Lemma image_dom: ∀ F, F⟦dom(F)⟧ = ran(F).
Proof.
  intros F.
  apply sub_a.
  split.
  + apply image_ran.
  + intros y P1.
    destruct (ran_e _ _ P1) as [x P2].
    apply image_i.
    exists x.
    split.
    - apply P2.
    - apply (dom_i _ _ _ P2).
Qed.

Lemma image_sub_dom_eq: ∀ F, ∀ G, ∀ A, fn G → F ⊆ G → A ⊆ dom(F)
  → F⟦A⟧ = G⟦A⟧.
Proof.
  intros F G A P2 P3 P4.
  apply sub_a.
  split.
  + intros y P5.
    destruct (image_e _ _ _ P5) as [x [P6 P7]].
    apply image_i.
    exists x.
    split.
    - apply (P3 _ P6).
    - apply P7.
  + intros y P5.
    destruct (image_e _ _ _ P5) as [x [P6 P7]].
    apply image_i.
    exists x.
    split.
    - destruct (dom_e _ _ (P4 _ P7)) as [y' P8].
      destruct P2 as [_ P2].
      apply (eq_cr (λ y, ⟨x, y⟩ ∈ F) (P2 _ _ _ P6 (P3 _ P8))).
      apply P8.
    - apply P7.
Qed.

Lemma image_surj: ∀ F, ∀ A, ∀ B, F ∈ A ↦ˢ B → F⟦A⟧ = B.
Proof.
  intros F A B P1.
  apply sub_a.
  split.
  + apply (eq_cl _ (surj_ran _ _ _ P1)).
    apply image_ran.
  + intros y P3.
    destruct (ran_e _ _ (eq_cr _ (surj_ran _ _ _ P1) P3)) as [x P4].
    apply image_i.
    exists x.
    split.
    - apply P4.
    - apply (eq_cl _ (surj_dom _ _ _ P1)).
      apply (dom_i _ _ _ P4).
Qed.

Lemma image_bij_psub: ∀ F, ∀ A, ∀ A', ∀ B, F ∈ A ↦ᵇ B → A' ⊂ A → F⟦A'⟧ ⊂ B.
Proof.
  intros F A A' B P1 P2.
  apply psub_i.
  + intros y P3.
    destruct (image_e _ _ _ P3) as [x [P4 _]].
    apply (eq_cl (λ x, y ∈ x) (bij_ran _ _ _ P1)).
    apply (ran_i _ _ _ P4).
  + destruct (psub_e2 _ _ P2) as [x [P3 P4]].
    apply neq_s.
    apply (neq_i _ _ (F[x])).
    - apply (eq_cl (λ y, _ ∈ y) (bij_ran _ _ _ P1)).
      apply fval_ran.
      * apply (bij_fn _ _ _ P1).
      * apply (eq_cr (λ y, x ∈ y) (bij_dom _ _ _ P1) P4).
    - intros P5.
      destruct (image_e _ _ _ P5) as [x' [P6 P7]].
      assert (x' = x) as P8.
      { destruct (bij_e _ _ _ P1) as [_ Q1].
        apply (fval_inj _ _ _ _ _ Q1 (psub_e _ _ P2 _ P7) P4).
        + apply fval_i.
          - apply (bij_fn _ _ _ P1).
          - apply P6. }
      apply P3.
      apply (eq_cl (λ x, x ∈ A') P8 P7).
Qed.
(*----------------------------------------------------------------------------*)

(* Inverse *)
Lemma inv_i: ∀ x, ∀ y, ∀ R, ⟨x, y⟩ ∈ R → ⟨y, x⟩ ∈ R⁻¹.
Proof.
  intros x y R P1.
  apply sub_i.
  + apply cp_i.
    - apply (ran_i _ _ _ P1).
    - apply (dom_i _ _ _ P1).
  + exists x.
    exists y.
    split.
    - apply P1.
    - apply eq_r.
Qed.

Lemma inv_e: ∀ x, ∀ y, ∀ R, ⟨x, y⟩ ∈ R⁻¹ → ⟨y, x⟩ ∈ R.
Proof.
  intros x y R P1.
  destruct (sub_e _ _ _ P1) as [_ [a [b [P2 P3]]]].
  apply (eq_cr (λ x, ⟨y, x⟩ ∈ R) (opair_eq_el _ _ _ _ P3)).
  apply (eq_cr (λ y, ⟨y, b⟩ ∈ R) (opair_eq_er _ _ _ _ P3)).
  apply P2.
Qed.

Lemma inv_rel: ∀ R, rel (R⁻¹).
Proof.
  intros R x P1.
  destruct (sub_e _ _ _ P1) as [P2 _].
  destruct (cp_e _ _ _ P2) as [a [b [_ [_ P3]]]].
  exists a.
  exists b.
  apply P3.
Qed.

Theorem inv_inv: ∀ F, rel F → (F⁻¹)⁻¹ = F.
Proof.
  intros F P1.
  apply sub_a.
  split.
  + intros x P2.
    destruct ((inv_rel (inv F)) x P2) as [a [b P3]].
    apply (eq_cr (λ x, x ∈ F) P3).
    apply inv_e.
    apply inv_e.
    apply (eq_cl (λ x, x ∈ inv(inv F)) P3).
    apply P2.
  + intros x P2.
    destruct (P1 x P2) as [a [b P3]].
    apply (eq_cr (λ x, x ∈ inv(inv F)) P3).
    apply inv_i.
    apply inv_i.
    apply (eq_cl (λ x, x ∈ F) P3).
    apply P2.
Qed.

(* 3F *)
Lemma inv_dom: ∀ F, dom(F⁻¹) = ran(F).
Proof.
  intros F.
  apply sub_a.
  split.
  + intros x P1.
    destruct (dom_e _ _ P1) as [y P2].
    apply (ran_i _ y).
    apply (inv_e _ _ _ P2).
  + intros x P1.
    destruct (ran_e _ _ P1) as [y P2].
    apply (dom_i _ _ y).
    apply (inv_i _ _ _ P2).
Qed.

Lemma inv_ran: ∀ F, ran(F⁻¹) = dom(F).
Proof.
  intros F.
  apply sub_a.
  split.
  + intros x P1.
    destruct (ran_e _ _ P1) as [y P2].
    apply (dom_i _ _ y).
    apply (inv_e _ _ _ P2).
  + intros x P1.
    destruct (dom_e _ _ P1) as [y P2].
    apply (ran_i _ y).
    apply (inv_i _ _ _ P2).
Qed.

Lemma inv_sing_rot: ∀ R, sing_rot R → sing_val (R⁻¹).
Proof.
  intros R P1 a b1 b2 P2 P3.
  apply (P1 _ _ _ (inv_e _ _ _ P2) (inv_e _ _ _ P3)).
Qed.

Lemma inv_sing_val: ∀ R, sing_val R → sing_rot (R⁻¹).
Proof.
  intros R P1 a b1 b2 P2 P3.
  apply (P1 _ _ _ (inv_e _ _ _ P2) (inv_e _ _ _ P3)).
Qed.

Lemma sing_rot_inv: ∀ R, sing_val (R⁻¹) → sing_rot R.
Proof.
  intros R P1 a1 a2 b P2 P3.
  apply (P1 _ _ _ (inv_i _ _ _ P2) (inv_i _ _ _ P3)).
Qed.

Lemma sing_val_inv: ∀ R, sing_rot (R⁻¹) → sing_val R.
Proof.
  intros R P1 a1 a2 b P2 P3.
  apply (P1 _ _ _ (inv_i _ _ _ P2) (inv_i _ _ _ P3)).
Qed.

(* 3F *)
Lemma inv_fn: ∀ F, sing_rot F → fn (F⁻¹).
Proof.
  intros F P1.
  split.
  + apply inv_rel.
  + apply (inv_sing_rot _ P1).
Qed.

Lemma inv_fn_sing_rot: ∀ F, fn (F⁻¹) → sing_rot F.
Proof.
  intros F [_ P1] a1 a2 b P2 P3.
  apply (P1 b a1 a2).
  + apply (inv_i _ _ _ P2).
  + apply (inv_i _ _ _ P3).
Qed.

Lemma fn_inv_sing_rot: ∀ F, fn F → sing_rot (F⁻¹).
Proof.
  intros F [_ P1] a1 a2 b P2 P3.
  apply (P1 b a1 a2).
  + apply (inv_e _ _ _ P2).
  + apply (inv_e _ _ _ P3).
Qed.

Lemma inv_sing_rot_fn: ∀ F, rel F → sing_rot (F⁻¹) → fn F.
Proof.
  intros F P1 P2.
  split.
  + apply P1.
  + apply (sing_val_inv _ P2).
Qed.

(* 3G *)
Lemma inv_fval_cancel1: ∀ F, ∀ A, ∀ B, ∀ x, F ∈ A ↦ⁱ B → x ∈ A → F⁻¹[F[x]] = x.
Proof.
  intros F A B x P1 P2.
  apply fval_i.
  + apply inv_fn.
    apply (inj_sing_rot _ _ _ P1).
  + apply inv_i.
    apply (fval_i2 _ _ (inj_fn _ _ _ P1)).
    apply (eq_cr _ (inj_dom _ _ _ P1) P2).
Qed.

Lemma inv_fval_cancel2: ∀ F, ∀ A, ∀ B, ∀ x, F ∈ A ↦ⁱ B → x ∈ ran(F)
  → F[F⁻¹[x]] = x.
Proof.
  intros F x A B P1 P2.
  apply fval_i.
  + apply (inj_fn _ _ _ P1).
  + apply inv_e.
    apply fval_i2.
    - apply (inv_fn _ (inj_sing_rot _ _ _ P1)).
    - apply (eq_cr _ (inv_dom F) P2).
Qed.

Lemma inv_bij: ∀ F, ∀ A, ∀ B, F ∈ A ↦ᵇ B → F⁻¹ ∈ B ↦ᵇ A.
Proof.
  intros F A B P1.
  apply bij_i.
  + apply (inv_fn _ (bij_sing_rot _ _ _ P1)).
  + apply (eq_cr (λ x, x = B) (inv_dom F)).
    apply (bij_ran _ _ _ P1).
  + apply (eq_cr (λ x, x = A) (inv_ran F)).
    apply (bij_dom _ _ _ P1).
  + apply inv_sing_val.
    apply (bij_fn _ _ _ P1).
Qed.

Lemma inv_image_ran: ∀ F, ∀ A, F⁻¹⟦A⟧ ⊆ dom(F).
Proof.
  intros F A.
  apply (eq_cl _ (inv_ran F)).
  apply image_ran.
Qed.
(*----------------------------------------------------------------------------*)

(* Composition *)
(* Only consider composition of two functions *)
Lemma comp_i: ∀ x, ∀ z, ∀ F, ∀ G, (∃ y, ⟨x, y⟩ ∈ F ∧ ⟨y, z⟩ ∈ G)
  → ⟨x, z⟩ ∈ G ∘ F.
Proof.
  intros x z F G [y [P1 P2]].
  apply sub_i.
  + apply cp_i.
    - apply (dom_i _ _ _ P1).
    - apply (ran_i _ _ _ P2).
  + exists x. exists y. exists z.
    repeat split.
    - apply P1.
    - apply P2.
Qed.

Lemma comp_e: ∀ x, ∀ z, ∀ F, ∀ G, ⟨x, z⟩ ∈ G ∘ F
  → (∃ y, ⟨x, y⟩ ∈ F ∧ ⟨y, z⟩ ∈ G).
Proof.
  intros x z F G P1.
  destruct (sub_e _ _ _ P1) as [_ [a [b [c [P2 [P3 P4]]]]]].
  exists b.
  split.
  + apply (eq_cr (λ x, ⟨x, b⟩ ∈ F) (opair_eq_el _ _ _ _ P4)).
    apply P2.
  + apply (eq_cr (λ z, ⟨b, z⟩ ∈ G) (opair_eq_er _ _ _ _ P4)).
    apply P3.
Qed.

Lemma comp_rel: ∀ F, ∀ G, rel(G ∘ F).
Proof.
  intros F G.
  apply cp_sub_rel.
Qed.

Lemma comp_e2: ∀ s, ∀ F, ∀ G, s ∈ G ∘ F →
  (∃ x, ∃ y, ∃ z, s = ⟨x, z⟩ ∧ ⟨x, y⟩ ∈ F ∧ ⟨y, z⟩ ∈ G).
Proof.
  intros s F G P1.
  destruct (comp_rel _ _ _ P1) as [x [z P2]].
  destruct (comp_e _ _ _ _ (eq_cl (λ s, s ∈ G ∘ F) P2 P1)) as [y P3].
  exists x.
  exists y.
  exists z.
  apply (and_i P2 P3).
Qed.

(* 3H *)
Lemma comp_sing_val: ∀ F, ∀ G, sing_val F → sing_val G → sing_val (G ∘ F).
Proof.
  intros F G P1 P2 a b1 b2 P3 P4.
  destruct (comp_e _ _ _ _ P3) as [e1 [P5 P6]].
  destruct (comp_e _ _ _ _ P4) as [e2 [P7 P8]].
  apply (P2 _ _ _ P6).
  apply (eq_cr (λ x, ⟨x, b2⟩ ∈ G) (P1 _ _ _ P5 P7)).
  apply P8.
Qed.

Lemma comp_sing_rot: ∀ F, ∀ G, sing_rot F → sing_rot G → sing_rot (G ∘ F).
Proof.
  intros F G P1 P2 a1 a2 b P3 P4.
  destruct (comp_e _ _ _ _ P3) as [e1 [P5 P6]].
  destruct (comp_e _ _ _ _ P4) as [e2 [P7 P8]].
  apply (P1 _ _ _ P5).
  apply (eq_cr (λ x, ⟨a2, x⟩ ∈ F) (P2 _ _ _ P6 P8)).
  apply P7.
Qed.

Lemma comp_fn: ∀ F, ∀ G, fn F → fn G → fn (G ∘ F).
Proof.
  intros F G [_ P1] [_ P2].
  split.
  + apply comp_rel.
  + apply (comp_sing_val _ _ P1 P2).
Qed.

Lemma comp_dom: ∀ F, ∀ G, dom(G ∘ F) ⊆ dom(F).
Proof.
  intros F G x P1.
  destruct (dom_e _ _ P1) as [z P2].
  destruct (comp_e _ _ _ _ P2) as [y [P3 _]].
  apply (dom_i _ _ y P3).
Qed.

Lemma comp_coin_dom: ∀ F, ∀ G, ran(F) = dom(G) → dom(G ∘ F) = dom(F).
Proof.
  intros F G P1.
  apply sub_a.
  split.
  + apply comp_dom.
  + intros x P2.
    destruct (dom_e _ _ P2) as [y P3].
    pose (eq_cl _ P1 (ran_i _ _ _ P3)) as P4.
    destruct (dom_e _ _ P4) as [z P5].
    apply (dom_i _ _ z).
    apply comp_i.
    exists y.
    apply (and_i P3 P5).
Qed.

Lemma comp_coin_dom_weak: ∀ F, ∀ G, ran(F) ⊆ dom(G) → dom(G ∘ F) = dom(F).
Proof.
  intros F G P1.
  apply sub_a.
  split.
  + apply comp_dom.
  + intros x P2.
    destruct (dom_e _ _ P2) as [y P3].
    pose (P1 _ (ran_i _ _ _ P3)) as P4.
    destruct (dom_e _ _ P4) as [z P5].
    apply (dom_i _ _ z).
    apply comp_i.
    exists y.
    apply (and_i P3 P5).
Qed.

Lemma comp_dom_fmap: ∀ F, ∀ G, ∀ A, ∀ B, ∀ C, F ∈ A ↦ B → G ∈ B ↦ C
  → dom (G ∘ F) = A.
Proof.
  intros F G A B C P1 P2.
  apply (eq_cl (λ x, _ = x) (fmap_dom _ _ _ P1)).
  apply comp_coin_dom_weak.
  apply (eq_cr (λ x, _ ⊆ x) (fmap_dom _ _ _ P2)).
  apply (fmap_ran _ _ _ P1).
Qed.

Lemma comp_dom_e: ∀ F, ∀ G, ∀ x, fn F → fn G → x ∈ dom(G ∘ F) → F[x] ∈ dom(G).
Proof.
  intros F G x P1 P2 P3.
  destruct (dom_e _ _ P3) as [z P4].
  destruct (comp_e _ _ _ _ P4) as [y [P5 P6]].
  apply (dom_i _ _ z).
  apply (eq_cr (λ x, ⟨x, z⟩ ∈ G) (fval_i _ _ _ P1 P5)).
  apply P6.
Qed.

Lemma comp_ran: ∀ F, ∀ G, ran(G ∘ F) ⊆ ran(G).
Proof.
  intros F G z P1.
  destruct (ran_e _ _ P1) as [x P2].
  destruct (comp_e _ _ _ _ P2) as [y [_ P3]].
  apply (ran_i _ y _ P3).
Qed.

Lemma comp_ran2: ∀ F, ∀ G, ran(G ∘ F) = G⟦ran(F)⟧.
Proof.
  intros F G.
  apply sub_a.
  split.
  + intros z P1.
    destruct (ran_e _ _ P1) as [x P2].
    destruct (comp_e _ _ _ _ P2) as [y [P3 P4]].
    apply image_i.
    exists y.
    split.
    - apply P4.
    - apply (ran_i _ _ _ P3).
  + intros z P1.
    destruct (image_e _ _ _ P1) as [y [P2 P3]].
    destruct (ran_e _ _ P3) as [x P4].
    apply (ran_i _ x _).
    apply (comp_i).
    exists y.
    apply (and_i P4 P2).
Qed.

Lemma comp_fmap: ∀ F, ∀ G, ∀ A, ∀ B, ∀ C, F ∈ A ↦ B → G ∈ B ↦ C → G ∘ F ∈ A ↦ C.
Proof.
  intros F G A B C P1 P2.
  apply fmap_i.
  + apply (comp_fn _ _ (fmap_fn _ _ _ P1) (fmap_fn _ _ _ P2)).
  + apply (eq_cl _ (fmap_dom _ _ _ P1)).
    apply comp_coin_dom_weak.
    apply (eq_cr _ (fmap_dom _ _ _ P2)).
    apply (fmap_ran _ _ _ P1).
  + apply (sub_t _ (ran(G)) _).
    - apply comp_ran.
    - apply (fmap_ran _ _ _ P2).
Qed.

Lemma comp_fval: ∀ F, ∀ G, ∀ x, fn F → fn G → x ∈ dom(G ∘ F) →
  G[F[x]] = (G ∘ F)[x].
Proof.
  intros F G x P1 P2 P3.
  apply eq_s.
  apply (fval_i _ _ _ (comp_fn _ _ P1 P2)).
  apply comp_i.
  exists (F[x]).
  split.
  + apply (fval_i2 _ _ P1).
    apply (comp_dom _ _ _ P3).
  + apply (fval_i2 _ _ P2).
    apply (comp_dom_e _ _ _ P1 P2 P3).
Qed.

Lemma comp_inj: ∀ F, ∀ G, ∀ A, ∀ B, ∀ C, F ∈ A ↦ⁱ B → G ∈ B ↦ⁱ C
  → G ∘ F ∈ A ↦ⁱ C.
Proof.
  intros F G A B C P1 P2.
  apply inj_i2.
  + apply (comp_fmap _ _ _ _ _ (inj_fmap _ _ _ P1) (inj_fmap _ _ _ P2)).
  + apply (comp_sing_rot _ _ (inj_sing_rot _ _ _ P1) (inj_sing_rot _ _ _ P2)).
Qed.

Lemma comp_surj: ∀ F, ∀ G, ∀ A, ∀ B, ∀ C, F ∈ A ↦ˢ B → G ∈ B ↦ˢ C
  → G ∘ F ∈ A ↦ˢ C.
Proof.
  intros F G A B C P1 P2.
  apply surj_i2.
  + apply (comp_fmap _ _ _ _ _ (surj_fmap _ _ _ P1) (surj_fmap _ _ _ P2)).
  + apply (eq_cr (λ x, x  = C) (comp_ran2 F G)).
    apply (eq_cr (λ x, G⟦x⟧ = C) (surj_ran _ _ _ P1)).
    apply (eq_cl (λ x, G⟦x⟧ = C) (surj_dom _ _ _ P2)).
    apply (eq_cl (λ x, G⟦dom(G)⟧ = x) (surj_ran _ _ _ P2)).
    apply image_dom.
Qed.

Lemma comp_bij: ∀ F, ∀ G, ∀ A, ∀ B, ∀ C, F ∈ A ↦ᵇ B → G ∈ B ↦ᵇ C
  → G ∘ F ∈ A ↦ᵇ C.
Proof.
  intros F G A B C P1 P2.
  destruct (bij_e _ _ _ P1) as [P3 P4].
  destruct (bij_e _ _ _ P2) as [P5 P6].
  apply bij_i3.
  + apply (comp_surj _ _ _ _ _ P3 P5).
  + apply (comp_inj _ _ _ _ _ P4 P6).
Qed.

Lemma comp_bij_weak: ∀ F, ∀ G, ∀ A, ∀ B1, ∀ B2, ∀ C, F ∈ A ↦ᵇ B1 → G ∈ B2 ↦ᵇ C
  → B1 ⊆ B2 → G ∘ F ∈ A ↦ᵇ G⟦B1⟧.
Proof.
  intros F G A B1 B2 C P1 P2 P3.
  apply bij_i.
  + apply (comp_fn _ _ (bij_fn _ _ _ P1) (bij_fn _ _ _ P2)).
  + apply sub_a.
    split.
    - apply (eq_cl (λ x, _ ⊆ x) (bij_dom _ _ _ P1)).
      apply comp_dom.
    - intros x P4.
      apply (dom_i _ _ (G[F[x]])).
      apply comp_i.
      exists (F[x]).
      split.
      * apply fval_i2.
        ++apply (bij_fn _ _ _ P1).
        ++apply (eq_cr (λ y, x ∈ y) (bij_dom _ _ _ P1) P4).
      * apply fval_i2.
        ++apply (bij_fn _ _ _ P2).
        ++apply (eq_cr (λ y, F[x] ∈ y) (bij_dom _ _ _ P2)).
          apply P3.
          apply (eq_cl (λ y, F[x] ∈ y) (bij_ran _ _ _ P1)).
          apply (fval_ran _ _ (bij_fn _ _ _ P1)).
          apply (eq_cr (λ y, x ∈ y) (bij_dom _ _ _ P1) P4).
  + apply sub_a.
    split.
    - intros y P4.
      destruct (ran_e _ _ P4) as [x P5].
      destruct (comp_e _ _ _ _ P5) as [s [P6 P7]].
      apply image_i.
      exists s.
      split.
      * apply P7.
      * apply (eq_cl (λ x, s ∈ x) (bij_ran _ _ _ P1)).
        apply (ran_i _ _ _ P6).
    - intros y P4.
      destruct (image_e _ _ _ P4) as [x [P5 P6]].
      apply (ran_i _ ((inv F)[x])).
      apply comp_i.
      exists x.
      split.
      * apply inv_e.
        apply fval_i2.
        ++apply inv_fn.
          apply (bij_sing_rot _ _ _ P1).
        ++apply (eq_cr (λ y, x ∈ y) (inv_dom _)).
          apply (eq_cr (λ s, x ∈ s) (bij_ran _ _ _ P1)).
          apply P6.
      * apply P5.
  + apply comp_sing_rot.
    - apply (bij_sing_rot _ _ _ P1).
    - apply (bij_sing_rot _ _ _ P2).
Qed.

(* 3I *)
Lemma comp_inv: ∀ F, ∀ G, (G ∘ F)⁻¹ = F⁻¹ ∘ G⁻¹.
Proof.
  intros F G.
  apply sub_a.
  split.
  + intros r P1.
    destruct (inv_rel _ r P1) as [x [z P2]].
    destruct (comp_e _ _ _ _ (inv_e _ _ _ (eq_cl (λ r, r ∈ inv (G ∘ F)) P2 P1)))
      as [y [P3 P4]].
    apply (eq_cr (λ r, r ∈ inv F ∘ inv G) P2).
    apply comp_i.
    exists y.
    split.
    - apply (inv_i _ _ _ P4).
    - apply (inv_i _ _ _ P3).
  + intros r P1.
    destruct (comp_rel _ _ r P1) as [x [z P2]].
    apply (eq_cr (λ r, r ∈ inv (G ∘ F)) P2).
    destruct (comp_e _ _ _ _ (eq_cl (λ r, r ∈ inv F ∘ inv G) P2 P1))
      as [y [P3 P4]] .
    apply inv_i.
    apply comp_i.
    exists y.
    split.
    - apply (inv_e _ _ _ P4).
    - apply (inv_e _ _ _ P3).
Qed.
(*----------------------------------------------------------------------------*)


Require Export A011profobj.

Print nat_ind.
(*
nat_ind =
fun P : nat -> Prop => nat_rect P
     : forall P : nat -> Prop,
       P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n
*)

Theorem mult_0_r' : forall n:nat,
  n * 0 = 0.
Proof.
  apply nat_ind. reflexivity.
  simpl. intros. assumption.
Qed.

Print nat_rect.

(*
nat_rect =
fun (P : nat -> Type) (f : P 0) (f0 : forall n : nat, P n -> P (S n)) =>
fix F (n : nat) : P n :=
  match n as n0 return (P n0) with
  | 0 => f
  | S n0 => f0 n0 (F n0)
  end
     : forall P : nat -> Type,
       P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n
*)

Definition nat_ind' (P : nat -> Prop) :
   (P 0) -> (forall n, P n -> P (S n)) -> forall n, P n.
Proof.
  intros. induction n.
  assumption. apply H0. assumption.
Defined.

Theorem plus_one_r' : forall n:nat,
  n + 1 = S n.
Proof.
  apply nat_ind'. reflexivity.
  intros. simpl. rewrite H. reflexivity.
Qed.

Print plus_one_r'.
(*
plus_one_r' =
nat_ind (fun n : nat => n + 1 = S n) eq_refl
  (fun (n : nat) (H : n + 1 = S n) =>
   eq_ind_r (fun n0 : nat => S n0 = S (S n)) eq_refl H)
     : forall n : nat, n + 1 = S n
*)

Inductive yesno : Type :=
  | yes : yesno
  | no : yesno.

Check yesno_ind.

Inductive rgb : Type :=
  | red : rgb
  | green : rgb
  | blue : rgb.

Definition rgb_ind' (P : rgb -> Prop) (_ : P red) (_ : P green) (_ : P blue)
   : forall a : rgb, P a.
Proof.
  intros.
  induction a; assumption.
Qed.

Check rgb_ind'. (* forall P : rgb -> Prop, P red -> P green -> P blue -> forall a : rgb, P a *)
Check rgb_ind.  (* forall P : rgb -> Prop, P red -> P green -> P blue -> forall r : rgb, P r *)

Inductive natlist : Type :=
  | nnil : natlist
  | ncons : nat -> natlist -> natlist.

Definition natlist_ind' (P : natlist -> Prop)
                        (_ : P nnil)
                        (_ : forall x l, P l -> P (ncons x l))
                        (n : natlist) := P n.
Check natlist_ind'.
(* !!!Notice!!! Not correct!
natlist_ind'
     : forall P : natlist -> Prop,
       P nnil ->
       (forall (x : nat) (l : natlist), P l -> P (ncons x l)) ->
       natlist -> Prop
*)

Check natlist_ind.
(*
natlist_ind
     : forall P : natlist -> Prop,
       P nnil ->
       (forall (n : nat) (n0 : natlist), P n0 -> P (ncons n n0)) ->
       forall n : natlist, P n
*)

Inductive natlist1 : Type :=
  | nnil1 : natlist1
  | nsnoc1 : natlist1 -> nat -> natlist1.

(* natlist1_ind :
 forall P : natlist1 -> Prop, P nnil1
                              -> (forall l, P l -> forall a, P (nsnoc1 l a))
                              -> forall l, P l.
*)
Check natlist1_ind.
(*
natlist1_ind
     : forall P : natlist1 -> Prop,
       P nnil1 ->
       (forall n : natlist1, P n -> forall n0 : nat, P (nsnoc1 n n0)) ->
       forall n : natlist1, P n
*)

Inductive byntree : Type :=
 | bempty : byntree
 | bleaf : yesno -> byntree
 | nbranch : yesno -> byntree -> byntree -> byntree.

(* byntree_ind
      : forall P: byntree -> Prop,
            P empty
        -> (forall x, P (bleaf x))
        -> (forall x t1 t2, P t1 -> P t2 -> P (nbranch x t1 t2))
        -> forall t, P t.
*)

Check byntree_ind.
(*
byntree_ind
     : forall P : byntree -> Prop,
       P bempty ->
       (forall y : yesno, P (bleaf y)) ->
       (forall (y : yesno) (b : byntree),
        P b -> forall b0 : byntree, P b0 -> P (nbranch y b b0)) ->
       forall b : byntree, P b
*)

(*
  ExSet_ind :
         ∀P : ExSet → Prop,
             (∀b : bool, P (con1 b)) →
             (∀(n : nat) (e : ExSet), P e → P (con2 n e)) →
             ∀e : ExSet, P e
*)

Inductive ExSet :=
  | con1 : bool -> ExSet
  | con2 : nat -> ExSet -> ExSet.
Check ExSet_ind.
(*
ExSet_ind
     : forall P : ExSet -> Prop,
       (forall b : bool, P (con1 b)) ->
       (forall (n : nat) (e : ExSet), P e -> P (con2 n e)) ->
       forall e : ExSet, P e
*)

Inductive tree (X:Type) : Type :=
  | leaf : X -> tree X
  | node : tree X -> tree X -> tree X.

Definition tree_ind' {X} (P : tree X -> Prop) :
    (forall x : X, P (leaf X x))
    -> (forall t1 t2 : tree X, P t1 -> P t2 -> P (node X t1 t2))
    -> forall t : tree X, P t.
admit.
Defined.

Check tree_ind.

(*
      mytype_ind :
        ∀(X : Type) (P : mytype X → Prop),
            (∀x : X, P (constr1 X x)) →
            (∀n : nat, P (constr2 X n)) →
            (∀m : mytype X, P m →
               ∀n : nat, P (constr3 X m n)) →
            ∀m : mytype X, P m
*)

Inductive mytype (X : Type) :=
  | constr1 : X -> mytype X
  | constr2 : nat -> mytype X
  | constr3 : mytype X -> nat -> mytype X.
Check mytype_ind.
(*
mytype_ind
     : forall (X : Type) (P : mytype X -> Prop),
       (forall x : X, P (constr1 X x)) ->
       (forall n : nat, P (constr2 X n)) ->
       (forall m : mytype X, P m -> forall n : nat, P (constr3 X m n)) ->
       forall m : mytype X, P m
*)

(*
      foo_ind :
        ∀(X Y : Type) (P : foo X Y → Prop),
             (∀x : X, P (bar X Y x)) →
             (∀y : Y, P (baz X Y y)) →
             (∀f1 : nat → foo X Y,
               (∀n : nat, P (f1 n)) → P (quux X Y f1)) →
             ∀f2 : foo X Y, P f2
*)
Inductive foo (X : Type) (Y : Type) :=
  | bar : X -> foo X Y
  | baz : Y -> foo X Y
  | quux : (nat -> foo X Y) -> foo X Y.
Check foo_ind.

(*
foo_ind
     : forall (X Y : Type) (P : foo X Y -> Prop),
       (forall x : X, P (bar X Y x)) ->
       (forall y : Y, P (baz X Y y)) ->
       (forall f1 : nat -> foo X Y,
        (forall n : nat, P (f1 n)) -> P (quux X Y f1)) ->
       forall f2 : foo X Y, P f2
*)

Inductive foo' (X:Type) : Type :=
  | C1 : list X -> foo' X -> foo' X
  | C2 : foo' X.

(*
foo'_ind :
  forall (X : Type) (P : foo' X -> Prop),
    (forall (l : list X) (f : foo' X), P f -> P (C1 X l f)) ->
    P (C2 X) ->
    forall f : foo' X, P f.
*)
Check foo'_ind.
(*
foo'_ind
     : forall (X : Type) (P : foo' X -> Prop),
       (forall (l : list X) (f : foo' X), P f -> P (C1 X l f)) ->
       P (C2 X) -> forall f1 : foo' X, P f1
*)

Theorem plus_assoc' :
  forall n m p, n + (m + p) = n + m + p.
Proof.
  intros.
  induction n as [| n'].
  reflexivity.
  simpl. rewrite IHn'. reflexivity.
Qed.

Theorem plus_comm' : forall n m : nat,
  n + m = m + n.
Proof.
  induction n as [| n'].
  intros. rewrite plus_0_r. reflexivity.
  intros. simpl. rewrite -> IHn'.
  rewrite plus_n_Sm. reflexivity.
Qed.

Definition P_pa : nat -> nat -> nat -> Prop :=
  fun n => fun m p => n + (m + p) = n + m + p.

Theorem plus_assoc'' :
  forall m, forall p, forall n, P_pa n m p.
Proof.
  intros m p.
  apply nat_ind. reflexivity.
  unfold P_pa. intros. simpl. rewrite H. reflexivity.
Qed.

Definition P_pc (n : nat) (m : nat) : Prop :=
  n + m = m + n.

Theorem plus_comm'' :
  forall m n, P_pc n m.
Proof.
  intro. apply nat_ind.
  unfold P_pc. rewrite plus_0_r. reflexivity.
  unfold P_pc. intros. simpl. rewrite -> H.
  rewrite plus_n_Sm. reflexivity.
Qed.

(*
Inductive beautiful : nat -> Prop :=
| b_0 : beautiful 0
| b_3 : beautiful 3
| b_5 : beautiful 5
| b_sum : forall m n : nat,
            beautiful m -> beautiful n ->
            beautiful (m + n).
*)

Lemma one_not_beautiful_FAILED: ~ beautiful 1.
Proof.
  intro H.
  remember 1.
  induction H; inversion Heqn.
  destruct m.
    destruct n.
      inversion H2.
      simpl in H2. apply IHbeautiful2 in H2. inversion H2.
    destruct n.
      rewrite plus_0_r in H2. apply IHbeautiful1 in H2. inversion H2.
      inversion H2. rewrite NPeano.Nat.add_succ_r in H3. inversion H3.
Qed.

Goal forall n m o, n <= m -> m <= o -> n <= o.
Proof.
  intros.
  induction H.
  assumption.


Require Import Coq.Logic.Classical_Prop.
Require Import Logic.lib.Coqlib.
Require Import Logic.GeneralLogic.Base.
Require Import Logic.GeneralLogic.Complete.ContextProperty.
Require Import Logic.GeneralLogic.ProofTheory.BasicSequentCalculus.
Require Import Logic.GeneralLogic.Complete.ContextProperty_Kripke.

Local Open Scope logic_base.

Section ContextProperty.

Context {L: Language}
        {Gamma: Derivable L}
        {bSC: BasicSequentCalculus L Gamma}.

Lemma maximal_consistent_spec :
  forall Phi, maximal consistent Phi <-> consistent Phi /\ forall x, consistent (Union _ Phi (Singleton _ x)) -> Phi x.
Proof.
  intros.
  split; intros [? ?]; split; auto.
  + intros.
    specialize (H0 _ H1).
    specialize (H0 (fun x H => Union_introl _ _ _ _ H)).
    specialize (H0 x).
    apply H0; right; constructor.
  + intros.
    hnf; intros.
    apply H0.
    unfold consistent in*.
    destruct H1 as [y ?].
    exists y.
    intro; apply H1.
    eapply deduction_weaken; [| exact H4].
    intros ? [? | ?]; auto.
    destruct H5; auto.
Qed.

Lemma maximal_consistent_derivable_closed:
  forall (Phi: context),
  maximal consistent Phi ->
  derivable_closed Phi.
Proof.
  intros.
  hnf; intros.
  assert (consistent (Union _ Phi (Singleton _ x))).
  {
    destruct H as [[y ?] _].
    exists y.
    intro.
    pose proof deduction_subst1 _ _ _ H0 H1.
    auto.
  }
  destruct H.
  specialize (H2 _ H1).
  specialize (H2 (fun x H => Union_introl _ _ _ x H)).
  apply H2.
  right; constructor.
Qed.

Lemma MCS_element_derivable:
  forall(Phi: context),
  maximal consistent Phi ->
  (forall x: expr, Phi x <-> Phi |--- x).
Proof.
  intros.
  apply derivable_closed_element_derivable, maximal_consistent_derivable_closed.
  auto.
Qed.

End ContextProperty.


(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** Correctness of instruction selection for integer division *)

Require Import Coqlib.
Require Import Zquot.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Values.
Require Import Memory.
Require Import Globalenvs.
Require Import Events.
Require Import Cminor.
Require Import Op.
Require Import CminorSel.
Require Import SelectOp.
Require Import SelectOpproof.
Require Import SelectDiv.

Open Local Scope cminorsel_scope.

(** * Main approximation theorems *)

Section Z_DIV_MUL.

Variable N: Z.      (**r number of relevant bits *)
Hypothesis N_pos: N >= 0.
Variable d: Z.      (**r divisor *)
Hypothesis d_pos: d > 0.

(** This is theorem 4.2 from Granlund and Montgomery, PLDI 1994. *)

Lemma Zdiv_mul_pos:
  forall m l,
  l >= 0 ->
  two_p (N+l) <= m * d <= two_p (N+l) + two_p l ->
  forall n,
  0 <= n < two_p N ->
  Zdiv n d = Zdiv (m * n) (two_p (N + l)).
Proof.
  intros m l l_pos [LO HI] n RANGE.
  exploit (Z_div_mod_eq n d). auto.
  set (q := n / d).
  set (r := n mod d).
  intro EUCL.
  assert (0 <= r <= d - 1).
    unfold r. generalize (Z_mod_lt n d d_pos). omega.
  assert (0 <= m).
    apply Zmult_le_0_reg_r with d. auto.
    exploit (two_p_gt_ZERO (N + l)). omega. omega.
  set (k := m * d - two_p (N + l)).
  assert (0 <= k <= two_p l).
    unfold k; omega.
  assert ((m * n - two_p (N + l) * q) * d = k * n + two_p (N + l) * r).
    unfold k. rewrite EUCL. ring.
  assert (0 <= k * n).
    apply Zmult_le_0_compat; omega.
  assert (k * n <= two_p (N + l) - two_p l).
    apply Zle_trans with (two_p l * n).
    apply Zmult_le_compat_r. omega. omega.
    replace (N + l) with (l + N) by omega.
    rewrite two_p_is_exp.
    replace (two_p l * two_p N - two_p l)
       with (two_p l * (two_p N - 1))
         by ring.
    apply Zmult_le_compat_l. omega. exploit (two_p_gt_ZERO l). omega. omega.
    omega. omega.
  assert (0 <= two_p (N + l) * r).
    apply Zmult_le_0_compat.
    exploit (two_p_gt_ZERO (N + l)). omega. omega.
    omega.
  assert (two_p (N + l) * r <= two_p (N + l) * d - two_p (N + l)).
    replace (two_p (N + l) * d - two_p (N + l))
       with (two_p (N + l) * (d - 1)) by ring.
    apply Zmult_le_compat_l.
    omega.
    exploit (two_p_gt_ZERO (N + l)). omega. omega.
  assert (0 <= m * n - two_p (N + l) * q).
    apply Zmult_le_reg_r with d. auto.
    replace (0 * d) with 0 by ring.  rewrite H2. omega.
  assert (m * n - two_p (N + l) * q < two_p (N + l)).
    apply Zmult_lt_reg_r with d. omega.
    rewrite H2.
    apply Zle_lt_trans with (two_p (N + l) * d - two_p l).
    omega.
    exploit (two_p_gt_ZERO l). omega. omega.
  symmetry. apply Zdiv_unique with (m * n - two_p (N + l) * q).
  ring. omega.
Qed.

Lemma Zdiv_unique_2:
  forall x y q, y > 0 -> 0 < y * q - x <= y -> Zdiv x y = q - 1.
Proof.
  intros. apply Zdiv_unique with (x - (q - 1) * y). ring.
  replace ((q - 1) * y) with (y * q - y) by ring. omega.
Qed.

Lemma Zdiv_mul_opp:
  forall m l,
  l >= 0 ->
  two_p (N+l) < m * d <= two_p (N+l) + two_p l ->
  forall n,
  0 < n <= two_p N ->
  Zdiv n d = - Zdiv (m * (-n)) (two_p (N + l)) - 1.
Proof.
  intros m l l_pos [LO HI] n RANGE.
  replace (m * (-n)) with (- (m * n)) by ring.
  exploit (Z_div_mod_eq n d). auto.
  set (q := n / d).
  set (r := n mod d).
  intro EUCL.
  assert (0 <= r <= d - 1).
    unfold r. generalize (Z_mod_lt n d d_pos). omega.
  assert (0 <= m).
    apply Zmult_le_0_reg_r with d. auto.
    exploit (two_p_gt_ZERO (N + l)). omega. omega.
  cut (Zdiv (- (m * n)) (two_p (N + l)) = -q - 1).
    omega.
  apply Zdiv_unique_2.
  apply two_p_gt_ZERO. omega.
  replace (two_p (N + l) * - q - - (m * n))
     with (m * n - two_p (N + l) * q)
       by ring.
  set (k := m * d - two_p (N + l)).
  assert (0 < k <= two_p l).
    unfold k; omega.
  assert ((m * n - two_p (N + l) * q) * d = k * n + two_p (N + l) * r).
    unfold k. rewrite EUCL. ring.
  split.
  apply Zmult_lt_reg_r with d. omega.
  replace (0 * d) with 0 by omega.
  rewrite H2.
  assert (0 < k * n). apply Zmult_lt_0_compat; omega.
  assert (0 <= two_p (N + l) * r).
    apply Zmult_le_0_compat. exploit (two_p_gt_ZERO (N + l)); omega. omega.
  omega.
  apply Zmult_le_reg_r with d. omega.
  rewrite H2.
  assert (k * n <= two_p (N + l)).
    rewrite Zplus_comm. rewrite two_p_is_exp; try omega.
    apply Zle_trans with (two_p l * n). apply Zmult_le_compat_r. omega. omega.
    apply Zmult_le_compat_l. omega. exploit (two_p_gt_ZERO l). omega. omega.
  assert (two_p (N + l) * r <= two_p (N + l) * d - two_p (N + l)).
    replace (two_p (N + l) * d - two_p (N + l))
       with (two_p (N + l) * (d - 1))
         by ring.
    apply Zmult_le_compat_l. omega. exploit (two_p_gt_ZERO (N + l)). omega. omega.
  omega.
Qed.

(** This is theorem 5.1 from Granlund and Montgomery, PLDI 1994. *)

Lemma Zquot_mul:
  forall m l,
  l >= 0 ->
  two_p (N+l) < m * d <= two_p (N+l) + two_p l ->
  forall n,
  - two_p N <= n < two_p N ->
  Z.quot n d = Zdiv (m * n) (two_p (N + l)) + (if zlt n 0 then 1 else 0).
Proof.
  intros. destruct (zlt n 0).
  exploit (Zdiv_mul_opp m l H H0 (-n)). omega.
  replace (- - n) with n by ring.
  replace (Z.quot n d) with (- Z.quot (-n) d).
  rewrite Zquot_Zdiv_pos by omega. omega.
  rewrite Z.quot_opp_l by omega. ring.
  rewrite Zplus_0_r. rewrite Zquot_Zdiv_pos by omega.
  apply Zdiv_mul_pos; omega.
Qed.

End Z_DIV_MUL.

(** * Correctness of the division parameters *)

Lemma divs_mul_params_sound:
  forall d m p,
  divs_mul_params d = Some(p, m) ->
  0 <= m < Int.modulus /\ 0 <= p < 32 /\
  forall n,
  Int.min_signed <= n <= Int.max_signed ->
  Z.quot n d = Zdiv (m * n) (two_p (32 + p)) + (if zlt n 0 then 1 else 0).
Proof with (try discriminate).
  unfold divs_mul_params; intros d m' p' EQ.
  destruct (find_div_mul_params Int.wordsize
               (Int.half_modulus - Int.half_modulus mod d - 1) d 32)
  as [[p m] | ]...
  destruct (zlt 0 d)...
  destruct (zlt (two_p (32 + p)) (m * d))...
  destruct (zle (m * d) (two_p (32 + p) + two_p (p + 1)))...
  destruct (zle 0 m)...
  destruct (zlt m Int.modulus)...
  destruct (zle 0 p)...
  destruct (zlt p 32)...
  simpl in EQ. inv EQ.
  split. auto. split. auto. intros.
  replace (32 + p') with (31 + (p' + 1)) by omega.
  apply Zquot_mul; try omega.
  replace (31 + (p' + 1)) with (32 + p') by omega. omega.
  change (Int.min_signed <= n < Int.half_modulus).
  unfold Int.max_signed in H. omega.
Qed.

Lemma divu_mul_params_sound:
  forall d m p,
  divu_mul_params d = Some(p, m) ->
  0 <= m < Int.modulus /\ 0 <= p < 32 /\
  forall n,
  0 <= n < Int.modulus ->
  Zdiv n d = Zdiv (m * n) (two_p (32 + p)).
Proof with (try discriminate).
  unfold divu_mul_params; intros d m' p' EQ.
  destruct (find_div_mul_params Int.wordsize
               (Int.modulus - Int.modulus mod d - 1) d 32)
  as [[p m] | ]...
  destruct (zlt 0 d)...
  destruct (zle (two_p (32 + p)) (m * d))...
  destruct (zle (m * d) (two_p (32 + p) + two_p p))...
  destruct (zle 0 m)...
  destruct (zlt m Int.modulus)...
  destruct (zle 0 p)...
  destruct (zlt p 32)...
  simpl in EQ. inv EQ.
  split. auto. split. auto. intros.
  apply Zdiv_mul_pos; try omega. assumption.
Qed.

Lemma divs_mul_shift_gen:
  forall x y m p,
  divs_mul_params (Int.signed y) = Some(p, m) ->
  0 <= m < Int.modulus /\ 0 <= p < 32 /\
  Int.divs x y = Int.add (Int.shr (Int.repr ((Int.signed x * m) / Int.modulus)) (Int.repr p))
                         (Int.shru x (Int.repr 31)).
Proof.
  intros. set (n := Int.signed x). set (d := Int.signed y) in *.
  exploit divs_mul_params_sound; eauto. intros (A & B & C).
  split. auto. split. auto.
  unfold Int.divs. fold n; fold d. rewrite C by (apply Int.signed_range).
  rewrite two_p_is_exp by omega. rewrite <- Zdiv_Zdiv.
  rewrite Int.shru_lt_zero. unfold Int.add. apply Int.eqm_samerepr. apply Int.eqm_add.
  rewrite Int.shr_div_two_p. apply Int.eqm_unsigned_repr_r. apply Int.eqm_refl2.
  rewrite Int.unsigned_repr. f_equal.
  rewrite Int.signed_repr. rewrite Int.modulus_power. f_equal. ring.
  cut (Int.min_signed <= n * m / Int.modulus < Int.half_modulus).
  unfold Int.max_signed; omega.
  apply Zdiv_interval_1. generalize Int.min_signed_neg; omega. apply Int.half_modulus_pos.
  apply Int.modulus_pos.
  split. apply Zle_trans with (Int.min_signed * m). apply Zmult_le_compat_l_neg. omega. generalize Int.min_signed_neg; omega.
  apply Zmult_le_compat_r. unfold n; generalize (Int.signed_range x); tauto. tauto.
  apply Zle_lt_trans with (Int.half_modulus * m).
  apply Zmult_le_compat_r. generalize (Int.signed_range x); unfold n, Int.max_signed; omega. tauto.
  apply Zmult_lt_compat_l. generalize Int.half_modulus_pos; omega. tauto.
  assert (32 < Int.max_unsigned) by (compute; auto). omega.
  unfold Int.lt; fold n. rewrite Int.signed_zero. destruct (zlt n 0); apply Int.eqm_unsigned_repr.
  apply two_p_gt_ZERO. omega.
  apply two_p_gt_ZERO. omega.
Qed.

Theorem divs_mul_shift_1:
  forall x y m p,
  divs_mul_params (Int.signed y) = Some(p, m) ->
  m < Int.half_modulus ->
  0 <= p < 32 /\
  Int.divs x y = Int.add (Int.shr (Int.mulhs x (Int.repr m)) (Int.repr p))
                         (Int.shru x (Int.repr 31)).
Proof.
  intros. exploit divs_mul_shift_gen; eauto. instantiate (1 := x).
  intros (A & B & C). split. auto. rewrite C.
  unfold Int.mulhs. rewrite Int.signed_repr. auto.
  generalize Int.min_signed_neg; unfold Int.max_signed; omega.
Qed.

Theorem divs_mul_shift_2:
  forall x y m p,
  divs_mul_params (Int.signed y) = Some(p, m) ->
  m >= Int.half_modulus ->
  0 <= p < 32 /\
  Int.divs x y = Int.add (Int.shr (Int.add (Int.mulhs x (Int.repr m)) x) (Int.repr p))
                         (Int.shru x (Int.repr 31)).
Proof.
  intros. exploit divs_mul_shift_gen; eauto. instantiate (1 := x).
  intros (A & B & C). split. auto. rewrite C. f_equal. f_equal.
  rewrite Int.add_signed. unfold Int.mulhs. set (n := Int.signed x).
  transitivity (Int.repr (n * (m - Int.modulus) / Int.modulus + n)).
  f_equal.
  replace (n * (m - Int.modulus)) with (n * m +  (-n) * Int.modulus) by ring.
  rewrite Z_div_plus. ring. apply Int.modulus_pos.
  apply Int.eqm_samerepr. apply Int.eqm_add; auto with ints.
  apply Int.eqm_sym. eapply Int.eqm_trans. apply Int.eqm_signed_unsigned.
  apply Int.eqm_unsigned_repr_l. apply Int.eqm_refl2. f_equal. f_equal.
  rewrite Int.signed_repr_eq. rewrite Zmod_small by assumption.
  apply zlt_false. omega.
Qed.

Theorem divu_mul_shift:
  forall x y m p,
  divu_mul_params (Int.unsigned y) = Some(p, m) ->
  0 <= p < 32 /\
  Int.divu x y = Int.shru (Int.mulhu x (Int.repr m)) (Int.repr p).
Proof.
  intros. exploit divu_mul_params_sound; eauto. intros (A & B & C).
  split. auto.
  rewrite Int.shru_div_two_p. rewrite Int.unsigned_repr.
  unfold Int.divu, Int.mulhu. f_equal. rewrite C by apply Int.unsigned_range.
  rewrite two_p_is_exp by omega. rewrite <- Zdiv_Zdiv by (apply two_p_gt_ZERO; omega).
  f_equal. rewrite (Int.unsigned_repr m).
  rewrite Int.unsigned_repr. f_equal. ring.
  cut (0 <= Int.unsigned x * m / Int.modulus < Int.modulus).
  unfold Int.max_unsigned; omega.
  apply Zdiv_interval_1. omega. compute; auto. compute; auto.
  split. simpl. apply Z.mul_nonneg_nonneg. generalize (Int.unsigned_range x); omega. omega.
  apply Zle_lt_trans with (Int.modulus * m).
  apply Zmult_le_compat_r. generalize (Int.unsigned_range x); omega. omega.
  apply Zmult_lt_compat_l. compute; auto. omega.
  unfold Int.max_unsigned; omega.
  assert (32 < Int.max_unsigned) by (compute; auto). omega.
Qed.

(** * Correctness of the smart constructors for division and modulus *)

Section CMCONSTRS.

Variable ge: genv.
Variable sp: val.
Variable e: env.
Variable m: mem.

Lemma eval_divu_mul:
  forall le x y p M,
  divu_mul_params (Int.unsigned y) = Some(p, M) ->
  nth_error le O = Some (Vint x) ->
  eval_expr ge sp e m le (divu_mul p M) (Vint (Int.divu x y)).
Proof.
  intros. unfold divu_mul. exploit (divu_mul_shift x); eauto. intros [A B].
  assert (eval_expr ge sp e m le
           (Eop Omulhu (Eletvar 0 ::: Eop (Ointconst (Int.repr M)) Enil ::: Enil))
           (Vint (Int.mulhu x (Int.repr M)))).
  { EvalOp. econstructor. econstructor; eauto. econstructor. EvalOp. simpl; reflexivity. constructor.
    auto. }
  exploit eval_shruimm. eexact H1. instantiate (1 := Int.repr p).
  intros [v [P Q]]. simpl in Q.
  replace (Int.ltu (Int.repr p) Int.iwordsize) with true in Q.
  inv Q. rewrite B. auto.
  unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true; auto. tauto.
  assert (32 < Int.max_unsigned) by (compute; auto). omega.
Qed.

Theorem eval_divuimm:
  forall le e1 x n2 z,
  eval_expr ge sp e m le e1 x ->
  Val.divu x (Vint n2) = Some z ->
  exists v, eval_expr ge sp e m le (divuimm e1 n2) v /\ Val.lessdef z v.
Proof.
  unfold divuimm; intros. generalize H0; intros DIV.
  destruct x; simpl in DIV; try discriminate.
  destruct (Int.eq n2 Int.zero) eqn:Z2; inv DIV.
  destruct (Int.is_power2 n2) as [l | ] eqn:P2.
- erewrite Int.divu_pow2 by eauto.
  replace (Vint (Int.shru i l)) with (Val.shru (Vint i) (Vint l)).
  apply eval_shruimm; auto.
  simpl. erewrite Int.is_power2_range; eauto.
- destruct (Compopts.optim_for_size tt).
  + eapply eval_divu_base; eauto. EvalOp.
  + destruct (divu_mul_params (Int.unsigned n2)) as [[p M] | ] eqn:PARAMS.
    * exists (Vint (Int.divu i n2)); split; auto.
      econstructor; eauto. eapply eval_divu_mul; eauto.
    * eapply eval_divu_base; eauto. EvalOp.
Qed.

Theorem eval_divu:
  forall le a b x y z,
  eval_expr ge sp e m le a x ->
  eval_expr ge sp e m le b y ->
  Val.divu x y = Some z ->
  exists v, eval_expr ge sp e m le (divu a b) v /\ Val.lessdef z v.
Proof.
  unfold divu; intros until b. destruct (divu_match b); intros.
- inv H0. inv H5. simpl in H7. inv H7. eapply eval_divuimm; eauto.
- eapply eval_divu_base; eauto.
Qed.

Lemma eval_mod_from_div:
  forall le a n x y,
  eval_expr ge sp e m le a (Vint y) ->
  nth_error le O = Some (Vint x) ->
  eval_expr ge sp e m le (mod_from_div a n) (Vint (Int.sub x (Int.mul y n))).
Proof.
  unfold mod_from_div; intros.
  exploit eval_mulimm; eauto. instantiate (1 := n). intros [v [A B]].
  simpl in B. inv B. EvalOp.
Qed.

Theorem eval_moduimm:
  forall le e1 x n2 z,
  eval_expr ge sp e m le e1 x ->
  Val.modu x (Vint n2) = Some z ->
  exists v, eval_expr ge sp e m le (moduimm e1 n2) v /\ Val.lessdef z v.
Proof.
  unfold moduimm; intros. generalize H0; intros MOD.
  destruct x; simpl in MOD; try discriminate.
  destruct (Int.eq n2 Int.zero) eqn:Z2; inv MOD.
  destruct (Int.is_power2 n2) as [l | ] eqn:P2.
- erewrite Int.modu_and by eauto.
  change (Vint (Int.and i (Int.sub n2 Int.one)))
    with (Val.and (Vint i) (Vint (Int.sub n2 Int.one))).
  apply eval_andimm. auto.
- destruct (Compopts.optim_for_size tt).
  + eapply eval_modu_base; eauto. EvalOp.
  + destruct (divu_mul_params (Int.unsigned n2)) as [[p M] | ] eqn:PARAMS.
    * econstructor; split.
      econstructor; eauto. eapply eval_mod_from_div.
      eapply eval_divu_mul; eauto. simpl; eauto. simpl; eauto.
      rewrite Int.modu_divu. auto.
      red; intros; subst n2; discriminate.
    * eapply eval_modu_base; eauto. EvalOp.
Qed.

Theorem eval_modu:
  forall le a b x y z,
  eval_expr ge sp e m le a x ->
  eval_expr ge sp e m le b y ->
  Val.modu x y = Some z ->
  exists v, eval_expr ge sp e m le (modu a b) v /\ Val.lessdef z v.
Proof.
  unfold modu; intros until b. destruct (modu_match b); intros.
- inv H0. inv H5. simpl in H7. inv H7. eapply eval_moduimm; eauto.
- eapply eval_modu_base; eauto.
Qed.

Lemma eval_divs_mul:
  forall le x y p M,
  divs_mul_params (Int.signed y) = Some(p, M) ->
  nth_error le O = Some (Vint x) ->
  eval_expr ge sp e m le (divs_mul p M) (Vint (Int.divs x y)).
Proof.
  intros. unfold divs_mul.
  assert (V: eval_expr ge sp e m le (Eletvar O) (Vint x)).
  { constructor; auto. }
  assert (X: eval_expr ge sp e m le
           (Eop Omulhs (Eletvar 0 ::: Eop (Ointconst (Int.repr M)) Enil ::: Enil))
           (Vint (Int.mulhs x (Int.repr M)))).
  { EvalOp. econstructor. eauto. econstructor. EvalOp. simpl; reflexivity. constructor.
    auto. }
  exploit eval_shruimm. eexact V. instantiate (1 := Int.repr (Int.zwordsize - 1)).
  intros [v1 [Y LD]]. simpl in LD.
  change (Int.ltu (Int.repr 31) Int.iwordsize) with true in LD.
  simpl in LD. inv LD.
  assert (RANGE: 0 <= p < 32 -> Int.ltu (Int.repr p) Int.iwordsize = true).
  { intros. unfold Int.ltu. rewrite Int.unsigned_repr. rewrite zlt_true by tauto. auto.
    assert (32 < Int.max_unsigned) by (compute; auto). omega. }
  destruct (zlt M Int.half_modulus).
- exploit (divs_mul_shift_1 x); eauto. intros [A B].
  exploit eval_shrimm. eexact X. instantiate (1 := Int.repr p). intros [v1 [Z LD]].
  simpl in LD. rewrite RANGE in LD by auto. inv LD.
  exploit eval_add. eexact Z. eexact Y. intros [v1 [W LD]].
  simpl in LD. inv LD.
  rewrite B. exact W.
- exploit (divs_mul_shift_2 x); eauto. intros [A B].
  exploit eval_add. eexact X. eexact V. intros [v1 [Z LD]].
  simpl in LD. inv LD.
  exploit eval_shrimm. eexact Z. instantiate (1 := Int.repr p). intros [v1 [U LD]].
  simpl in LD. rewrite RANGE in LD by auto. inv LD.
  exploit eval_add. eexact U. eexact Y. intros [v1 [W LD]].
  simpl in LD. inv LD.
  rewrite B. exact W.
Qed.

Theorem eval_divsimm:
  forall le e1 x n2 z,
  eval_expr ge sp e m le e1 x ->
  Val.divs x (Vint n2) = Some z ->
  exists v, eval_expr ge sp e m le (divsimm e1 n2) v /\ Val.lessdef z v.
Proof.
  unfold divsimm; intros. generalize H0; intros DIV.
  destruct x; simpl in DIV; try discriminate.
  destruct (Int.eq n2 Int.zero
            || Int.eq i (Int.repr Int.min_signed) && Int.eq n2 Int.mone) eqn:Z2; inv DIV.
  destruct (Int.is_power2 n2) as [l | ] eqn:P2.
- destruct (Int.ltu l (Int.repr 31)) eqn:LT31.
  + eapply eval_shrximm; eauto. eapply Val.divs_pow2; eauto.
  + eapply eval_divs_base; eauto. EvalOp.
- destruct (Compopts.optim_for_size tt).
  + eapply eval_divs_base; eauto. EvalOp.
  + destruct (divs_mul_params (Int.signed n2)) as [[p M] | ] eqn:PARAMS.
    * exists (Vint (Int.divs i n2)); split; auto.
      econstructor; eauto. eapply eval_divs_mul; eauto.
    * eapply eval_divs_base; eauto. EvalOp.
Qed.

Theorem eval_divs:
  forall le a b x y z,
  eval_expr ge sp e m le a x ->
  eval_expr ge sp e m le b y ->
  Val.divs x y = Some z ->
  exists v, eval_expr ge sp e m le (divs a b) v /\ Val.lessdef z v.
Proof.
  unfold divs; intros until b. destruct (divs_match b); intros.
- inv H0. inv H5. simpl in H7. inv H7. eapply eval_divsimm; eauto.
- eapply eval_divs_base; eauto.
Qed.

Theorem eval_modsimm:
  forall le e1 x n2 z,
  eval_expr ge sp e m le e1 x ->
  Val.mods x (Vint n2) = Some z ->
  exists v, eval_expr ge sp e m le (modsimm e1 n2) v /\ Val.lessdef z v.
Proof.
  unfold modsimm; intros.
  exploit Val.mods_divs; eauto. intros [y [A B]].
  generalize A; intros DIV.
  destruct x; simpl in DIV; try discriminate.
  destruct (Int.eq n2 Int.zero
            || Int.eq i (Int.repr Int.min_signed) && Int.eq n2 Int.mone) eqn:Z2; inv DIV.
  destruct (Int.is_power2 n2) as [l | ] eqn:P2.
- destruct (Int.ltu l (Int.repr 31)) eqn:LT31.
  + exploit (eval_shrximm ge sp e m (Vint i :: le) (Eletvar O)).
    constructor. simpl; eauto. eapply Val.divs_pow2; eauto.
    intros [v1 [X LD]]. inv LD.
    econstructor; split. econstructor. eauto.
    apply eval_mod_from_div. eexact X. simpl; eauto.
    simpl. auto.
  + eapply eval_mods_base; eauto. EvalOp.
- destruct (Compopts.optim_for_size tt).
  + eapply eval_mods_base; eauto. EvalOp.
  + destruct (divs_mul_params (Int.signed n2)) as [[p M] | ] eqn:PARAMS.
    * econstructor; split.
      econstructor. eauto. apply eval_mod_from_div with (x := i); auto.
      eapply eval_divs_mul with (x := i); eauto.
      simpl. auto.
    * eapply eval_mods_base; eauto. EvalOp.
Qed.

Theorem eval_mods:
  forall le a b x y z,
  eval_expr ge sp e m le a x ->
  eval_expr ge sp e m le b y ->
  Val.mods x y = Some z ->
  exists v, eval_expr ge sp e m le (mods a b) v /\ Val.lessdef z v.
Proof.
  unfold mods; intros until b. destruct (mods_match b); intros.
- inv H0. inv H5. simpl in H7. inv H7. eapply eval_modsimm; eauto.
- eapply eval_mods_base; eauto.
Qed.

(** * Floating-point division *)

Theorem eval_divf:
  forall le a b x y,
  eval_expr ge sp e m le a x ->
  eval_expr ge sp e m le b y ->
  exists v, eval_expr ge sp e m le (divf a b) v /\ Val.lessdef (Val.divf x y) v.
Proof.
  intros until y. unfold divf. destruct (divf_match b); intros.
- unfold divfimm. destruct (Float.exact_inverse n2) as [n2' | ] eqn:EINV.
  + inv H0. inv H4. simpl in H6. inv H6. econstructor; split.
    EvalOp. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor.
    simpl; eauto.
    destruct x; simpl; auto. erewrite Float.div_mul_inverse; eauto.
  + TrivialExists.
- TrivialExists.
Qed.

Theorem eval_divfs:
  forall le a b x y,
  eval_expr ge sp e m le a x ->
  eval_expr ge sp e m le b y ->
  exists v, eval_expr ge sp e m le (divfs a b) v /\ Val.lessdef (Val.divfs x y) v.
Proof.
  intros until y. unfold divfs. destruct (divfs_match b); intros.
- unfold divfsimm. destruct (Float32.exact_inverse n2) as [n2' | ] eqn:EINV.
  + inv H0. inv H4. simpl in H6. inv H6. econstructor; split.
    EvalOp. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor.
    simpl; eauto.
    destruct x; simpl; auto. erewrite Float32.div_mul_inverse; eauto.
  + TrivialExists.
- TrivialExists.
Qed.

End CMCONSTRS.