(* week_35.v *)
(* dIFP 2014-2015, Q1 *)
(* Olivier Danvy <danvy@cs.au.dk> *)

(* **********

   (0) download and install on your computer:
       - Coq
       - Emacs with Proof General (tick "3 Windows mode layout" in the Coq top menu;
         use the hybrid mode if your screen is not wide enough)

   (1) edit the present file, and step through it with Coq,
       proving the lemmas as you go

   ********** *)

Check O.

Check 0.

Check 1.

Check S O.

Check S 1.

Check S (S (S O)).

Check (fun x => S x).

Check S.

Check (fun x => S (S x)).

Check (fun f => fun x => S (f (S x))).

Check (fun f x => S (f (S x))).

Check 1 + 2.

Compute 1 + 2.

Check
  (fun (P : Prop) (p : P) => p).

Check
  (fun (P Q : Prop) (p : P) (q : Q) => p).

Check
  (fun (P Q : Prop) (p : P) (q : Q) => q).

(* ********** *)

(* Propositional logic:

   P ::= X
       | P -> P
       | P /\ P
       | P \/ P

   X ::= A | B | C | D | E | ...

   forall A B C ... : Prop, p
*)

(*
   intro and apply
*)

Lemma La :
  forall P : Prop,
    P -> P.
Proof.
  intro P.
  intro H_P.
  apply H_P.
Qed.

(*
   intros
*)

Lemma La' :
  forall P : Prop,
    P -> P.
Proof.
  intros P H_P.
  apply H_P.
Qed.

Lemma Lb :
  forall P Q : Prop,
    P -> Q -> P.
Proof.
  intro P.
  intro Q.
  intro H_P.
  intro H_Q.
  apply H_P.
Qed.

Lemma Lb' :
  forall P Q : Prop,
    P -> Q -> P.
Proof.
  intros P Q.
  intros H_P H_Q.
  apply H_P.
Qed.

Lemma Lb'' :
  forall P Q : Prop,
    P -> Q -> P.
Proof.
  intros P Q H_P H_Q.
  apply H_P.
Qed.

Lemma Lc :
  forall P Q : Prop,
    P -> Q -> Q.
Proof.
  intros P Q.
  intros H_P H_Q.
  apply H_Q.
Qed.

Lemma Ld :
  forall P1 P2 P3 P4 P5 : Prop,
    P1 -> P2 -> P3 -> P4 -> P5 -> P3.
Proof.
  intros P1 P2 P3 P4 P5.
  intros H_P1 H_P2 H_P3 H_P4 H_P5.
  apply H_P3.
Qed.

(* ********** *)

(* conjunction in an assumption: use destruct *)

Lemma Ca :
  forall P1 P2 : Prop,
    P1 /\ P2 -> P2.
Proof.
  intros P1 P2.
  intros H_P1_and_P2.
  destruct H_P1_and_P2 as [H_P1 H_P2].
  apply H_P2.
Qed.

Lemma Ca' :
  forall P1 P2 : Prop,
    P1 /\ P2 -> P2.
Proof.
  intros P1 P2.
  intros [H_P1 H_P2].
  apply H_P2.
Qed.

Lemma Ca'' :
  forall P1 P2 : Prop,
    P1 /\ P2 -> P1.
Proof.
  intros P1 P2.
  intros [H_P1 H_P2].
  apply H_P1.
Qed.

Lemma Cb :
  forall P1 P2 P3 : Prop,
    P1 /\ (P2 /\ P3) -> P3.
Proof.
  intros P1 P2 P3.
  intros [H_P1 [H_P2 H_P3]].
  apply H_P3.
Qed.

Lemma Cb' :
  forall P1 P2 P3 : Prop,
    P1 /\ P2 /\ P3 -> P3.
Proof.
  intros P1 P2 P3.
  intros [H_P1 [H_P2 H_P3]].
  apply H_P3.
Qed.

Lemma Cc :
  forall P1 P2 P3 P4 : Prop,
    (P1 /\ P2) /\ (P3 /\ P4) -> P3.
Proof.
  intros P1 P2 P3 P4.
  intros [[H_P1 H_P2] [H_P3 H_P4]].
  apply H_P3.
Qed.
(* ********** *)

(* conjunction in the goal: use split *)

Lemma conjunction_is_commutative :
  forall P Q : Prop,
    P /\ Q -> Q /\ P.
Proof.
  intros P Q.
  intros [H_P H_Q].
  split.
    apply H_Q.
    apply H_P.
Qed.

Lemma conjunction_is_commutative' :
  forall P Q : Prop,
    P /\ Q -> Q /\ P.
Proof.
  intros P Q [H_P H_Q].
  split.
    apply H_Q.
    apply H_P.
Qed.

(*
   Notation: "X <-> Y" is the same as "(X -> Y) /\ (Y -> X)"
*)

Lemma conjunction_is_commutative_either_way :
  forall P Q : Prop,
    P /\ Q <-> Q /\ P.
Proof.
  intros P Q.
  split.
    intros [H_P H_Q].
    split.
    apply H_Q.
    apply H_P.

    intros [H_Q H_P].
    split.
    apply H_P.
    apply H_Q.
Qed.

(* Simpler: apply conjunction_is_commutative instead of repeating its proof *)

Lemma conjunction_is_commutative_either_way' :
  forall P Q : Prop,
    P /\ Q <-> Q /\ P.
Proof.
  intros P Q.
  split.
  apply (conjunction_is_commutative P Q).
  apply (conjunction_is_commutative Q P).
Qed.

Lemma conjunction_is_associative_from_left_to_right :
  forall P1 P2 P3 : Prop,
    (P1 /\ P2) /\ P3 -> P1 /\ (P2 /\ P3).
Proof.
  intros P1 P2 P3.
  intros [[H_P1 H_P2] H_P3].
  split.
    apply H_P1.
    split.
      apply H_P2.
      apply H_P3.
Qed.

Lemma conjunction_is_associative_from_right_to_left :
  forall P1 P2 P3 : Prop,
    P1 /\ (P2 /\ P3) -> (P1 /\ P2) /\ P3.
Proof.
  intros P1 P2 P3.
  intros [H_P1 [H_P2 H_P3]].
  split.
  split.
  apply H_P1.
  apply H_P2.
  apply H_P3.
Qed.

Lemma conjunction_is_associative_either_way :
  forall P1 P2 P3 : Prop,
    P1 /\ (P2 /\ P3) <-> (P1 /\ P2) /\ P3.
Proof.
  intros P1 P2 P3.
  split.
  apply conjunction_is_associative_from_right_to_left.
  apply conjunction_is_associative_from_left_to_right.
Qed.

Lemma conjunction_is_associative_4_from_left_to_right :
  forall P1 P2 P3 P4 : Prop,
    P1 /\ (P2 /\ (P3 /\ P4)) -> ((P1 /\ P2) /\ P3) /\ P4.
Proof.
  intros P1 P2 P3 P4.
  intros [H_P1 [H_P2 [H_P3 H_P4]]].
  split.
  split.
  split.
  apply H_P1.
  apply H_P2.
  apply H_P3.
  apply H_P4.
Qed.

Lemma conjunction_is_associative_4_from_right_to_left :
  forall P1 P2 P3 P4 : Prop,
    ((P1 /\ P2) /\ P3) /\ P4 -> P1 /\ (P2 /\ (P3 /\ P4)).
Proof.
  intros P1 P2 P3 P4.
  intros [[[H_P1 H_P2] H_P3] H_P4].
  split.
  apply H_P1.
  split.
  apply H_P2.
  split.
  apply H_P3.
  apply H_P4.
Qed.

Lemma conjunction_is_associative_4_either_way :
  forall P1 P2 P3 P4 : Prop,
    P1 /\ (P2 /\ (P3 /\ P4)) <-> ((P1 /\ P2) /\ P3) /\ P4.
Proof.
  intros P1 P2 P3 P4.
  split.
  apply (conjunction_is_associative_4_from_left_to_right P1 P2 P3 P4).
  apply (conjunction_is_associative_4_from_right_to_left P1 P2 P3 P4).
Qed.

(* ********** *)

(* disjunction in the goal: use left or right *)

Lemma whatever_1 :
  forall P Q : Prop,
    P -> Q -> P \/ Q.
Proof.
  intros P Q.
  intros H_P H_Q.
  left.
  apply H_P.
Qed.

Lemma whatever_1' :
  forall P Q : Prop,
    P -> Q -> P \/ Q.
Proof.
  intros P Q.
  intros H_P H_Q.
  right.
  apply H_Q.
Qed.

(* ********** *)

(* disjunction in an assumption: use destruct *)

Lemma disjunction_is_commutative :
  forall P Q : Prop,
    P \/ Q -> Q \/ P.
Proof.
  intros P Q.
  intro H_P_or_Q.
  destruct H_P_or_Q as [H_P | H_Q].
  right.
  apply H_P.
  left.
  apply H_Q.
Qed.

Lemma disjunction_is_commutative' :
  forall P Q : Prop,
    P \/ Q -> Q \/ P.
Proof.
  intros P Q.
  intros [H_P | H_Q].
  right.
  apply H_P.
  left.
  apply H_Q.
Qed.

Lemma disjunction_is_commutative'' :
  forall P Q : Prop,
    P \/ Q -> Q \/ P.
Proof.
  intros P Q [H_P | H_Q].
  right.
  apply H_P.
  left.
  apply H_Q.
Qed.

Lemma disjunction_is_commutative_either_way :
  forall P Q : Prop,
    P \/ Q <-> Q \/ P.
Proof.
  intros P Q.
  split.
  intros [H_P | H_Q].
  right.
  apply H_P.
  left.
  apply H_Q.
  intros [H_Q | H_P].
  right.
  apply H_Q.
  left.
  apply H_P.
Qed.

Lemma disjunction_is_associative_from_left_to_right :
  forall P1 P2 P3 : Prop,
    (P1 \/ P2) \/ P3 -> P1 \/ (P2 \/ P3).
Proof.
  intros P1 P2 P3 [[H_P1 | H_P2] | H_P3].
  left. apply H_P1.
  right. left. apply H_P2.
  right. right. apply H_P3.
Qed.

Lemma disjunction_is_associative_from_right_to_left :
  forall P1 P2 P3 : Prop,
    P1 \/ (P2 \/ P3) -> (P1 \/ P2) \/ P3.
Proof.
  intros P1 P2 P3 [ H_P1 | [ H_P2 | H_P3]].
  left. left. apply H_P1.
  left. right. apply H_P2.
  right. apply H_P3.
Qed.

Lemma disjunction_is_associative_either_way :
  forall P1 P2 P3 : Prop,
    P1 \/ (P2 \/ P3) <-> (P1 \/ P2) \/ P3.
Proof.
  intros P1 P2 P3.
  split.
  apply (disjunction_is_associative_from_right_to_left P1 P2 P3).
  apply (disjunction_is_associative_from_left_to_right P1 P2 P3).
Qed.

Lemma disjunction_is_associative_4_from_left_to_right :
  forall P1 P2 P3 P4 : Prop,
    P1 \/ (P2 \/ (P3 \/ P4)) -> ((P1 \/ P2) \/ P3) \/ P4.
Proof.
  intros P1 P2 P3 P4.
  intros [H_P1 | [ H_P2 | [H_P3 | H_P4]]].
  left. left. left. apply H_P1.
  left. left. right. apply H_P2.
  left. right. apply H_P3.
  right. apply H_P4.
Qed.

Lemma disjunction_is_associative_4_from_right_to_left :
  forall P1 P2 P3 P4 : Prop,
    ((P1 \/ P2) \/ P3) \/ P4 -> P1 \/ (P2 \/ (P3 \/ P4)).
Proof.
  intros P1 P2 P3 P4.
  intros [[[H_P1 | H_P2] | H_P3] | H_P4].
  left. apply H_P1.
  right. left. apply H_P2.
  right. right. left. apply H_P3.
  right. right. right. apply H_P4.
Qed.

Lemma disjunction_is_associative_4_either_way :
  forall P1 P2 P3 P4 : Prop,
    P1 \/ (P2 \/ (P3 \/ P4)) <-> ((P1 \/ P2) \/ P3) \/ P4.
Proof.
  intros P1 P2 P3 P4.
  split.
  apply (disjunction_is_associative_4_from_left_to_right P1 P2 P3 P4).
  apply (disjunction_is_associative_4_from_right_to_left P1 P2 P3 P4).
Qed.

(* ********** *)

Lemma transitivity_of_implication :
  forall A B C : Prop,
    (A -> B) -> (B -> C) -> (A -> C).
Proof.
  intros A B C.
  intro H_A_implies_B.
  intro H_B_implies_C.
  intro H_A.
  apply H_B_implies_C.
  apply H_A_implies_B.
  apply H_A.
Qed.

Lemma transitivity_of_implication' :
  forall A B C : Prop,
    (B -> C) -> (A -> B) -> (A -> C).
Proof.
  intros A B C.
  intro H_B_IMPLIES_C.
  intro H_A_IMPLIES_B.
  intro H_A.
  apply H_B_IMPLIES_C.
  apply H_A_IMPLIES_B.
  apply H_A.
Qed.

Lemma Le :
  forall A B C: Prop,
    (A \/ B -> C) -> (A -> C) \/ (B -> C).
Proof.
  intros A B C.
  intro H_A_or_B_implies_C.
  left.
  intro H_A.
  apply H_A_or_B_implies_C.
  left.
  apply H_A.

  Restart.

  intros A B C.
  intro H_A_or_B_implies_C.
  right.
  intro H_B.
  apply H_A_or_B_implies_C.
  right.
  apply H_B.
Qed.

(* CANT MAKE THIS ONE WORK *)
Lemma Le' :
  forall A B C: Prop,
    (A -> C) \/ (B -> C) -> (A \/ B -> C).
Proof.
Admitted.

Lemma Lf :
  forall A B C: Prop,
    (A \/ B -> C) -> (A -> C) /\ (B -> C).
Proof.
  intros A B C.
  intro H_A_OR_B_IMPLIES_C.
  split.
  intro H_A.
  apply H_A_OR_B_IMPLIES_C.
  left.
  apply H_A.
  intro H_B.
  apply H_A_OR_B_IMPLIES_C.
  right.
  apply H_B.
Qed.

Lemma Lf' :
  forall A B C: Prop,
    (A -> C) /\ (B -> C) -> (A \/ B -> C).
Proof.
  intros A B C.
  intro H_A_OR_B_IMPLIES_C.
  destruct H_A_OR_B_IMPLIES_C as [H_P1 H_P2].
  intro H_A_OR_B.
  destruct H_A_OR_B.
  apply H_P1.
  apply H.
  apply H_P2.
  apply H.
Qed.

Lemma Lg :
  forall A B C: Prop,
    (A /\ B -> C) -> (A -> C) \/ (B -> C).
Proof.
Admitted.

(* TODO: Better naming *)
Lemma Lg' :
  forall A B C: Prop,
    (A -> C) \/ (B -> C) -> (A /\ B -> C).
Proof.
  intros A B C.
  intro H_A_OR_B_IMPLIES_C.
  destruct H_A_OR_B_IMPLIES_C.
  intro H_A_AND_B.
  destruct H_A_AND_B.
  apply H.
  apply H0.
  intro H_A_AND_B.
  destruct H_A_AND_B.
  apply H.
  apply H1.
Qed.

Lemma Lh :
  forall A B C: Prop,
    (A /\ B -> C) -> (A -> C) /\ (B -> C).
Proof.
Admitted.

Lemma Lh' :
  forall A B C: Prop,
    (A -> C) /\ (B -> C) -> (A /\ B -> C).
Proof.
  intros A B C.
  intro H_A_AND_B_IMPLIES_C.
  destruct H_A_AND_B_IMPLIES_C.
  intro H_A_AND_B.
  destruct H_A_AND_B.
  apply H.
  apply H1.
Qed.

(* ********** *)

Lemma distributivity_of_disjunction_over_conjunction:
  forall A B C : Prop,
    A \/ (B /\ C) <-> (A \/ B) /\ (A \/ C).
Proof.
  intros A B C.
  split.
  intro H_A_OR_B_AND_C.
  destruct H_A_OR_B_AND_C.
  split.
  left.
  apply H.
  left.
  apply H.
  split.
  destruct H.
  right.
  apply H.
  destruct H.
  right.
  apply H0.

  intro H_A_OR_B_AND_A_OR_C.
  destruct H_A_OR_B_AND_A_OR_C.
  destruct H.
  destruct H0.
  left.
  apply H.
  left.
  apply H.
  Admitted.

Lemma distributivity_of_conjunction_over_disjunction:
  forall A B C : Prop,
    A /\ (B \/ C) <-> (A /\ B) \/ (A /\ C).
Proof.
  intros A B C.
  split.
  intro H_A_AND_B_OR_C.
  destruct H_A_AND_B_OR_C.
  destruct H0.
  left.
  split.
  apply H.
  apply H0.
  right.
  split.
  apply H.
  apply H0.

  intro H_A_AND_B_OR_A_AND_C.
  destruct H_A_AND_B_OR_A_AND_C.
  destruct H.
  split.
  apply H.
  left.
  apply H0.
  destruct H.
  split.
  apply H.
  right.
  apply H0.
 Qed.

(* ********** *)

Lemma Curry :
  forall P Q R : Prop,
    (P /\ Q -> R) -> (P -> Q -> R).
Proof.
  intros P Q R.
  intro H_P_AND_Q_IMPLIES_R.
  intro H_P.
  intro H_Q.
  apply H_P_AND_Q_IMPLIES_R.
  split.
  apply H_P.
  apply H_Q.
Qed.

Lemma unCurry :
  forall P Q R : Prop,
    (P -> Q -> R) -> (P /\ Q -> R).
Proof.
  intros P Q R.
  intro H_P_Q_R.
  intro H_P_AND_Q.
  apply H_P_Q_R.
  destruct H_P_AND_Q.
  apply H.
  destruct H_P_AND_Q.
  apply H0.
Qed.

Lemma Curry_and_unCurry :
  forall P Q R : Prop,
    (P /\ Q -> R) <-> P -> Q -> R.
Proof.
  intros P Q R.
  split.
  apply (Curry P Q R).
  apply (unCurry P Q R).
Qed.

(* ********** *)

(* Here is how to import a Coq library about arithmetic expressions: *)

Require Import Arith.

Check plus_comm.

(*
plus_comm
     : forall n m : nat, n + m = m + n
*)

Lemma comm_a :
  forall a b c : nat,
    (a + b) + c = c + (b + a).
Proof.
  intros a b c.
  rewrite -> (plus_comm a b).
  rewrite -> (plus_comm (b + a) c).
  reflexivity.
 Qed.

Lemma comm_b :
  forall x y z : nat,
    (x + y) + z = z + (y + x).
Proof.
  intros x y z.
  apply (comm_a x y z).
Qed.

(* symmetry *)

Lemma comm_c :
  forall a b c : nat,
    c + (b + a) = (a + b) + c.
Proof.
  intros a b c.
  rewrite <- (plus_comm a b).
  rewrite <- (plus_comm (a + b) c).
  reflexivity.
Qed.

(* ********** *)

Check plus_assoc.

(*
plus_assoc
     : forall n m p : nat, n + (m + p) = n + m + p
*)

Lemma assoc_a :
  forall a b c d : nat,
    ((a + b) + c) + d = a + (b + (c + d)).
Proof.
  intros a b c d.

  rewrite -> (plus_assoc a b (c + d)).
  rewrite -> (plus_assoc (a + b) c d).
  reflexivity.
Qed.

(* ********** *)

Lemma mixed_a :
forall a b c d : nat,
    (c + (a + b)) + d = (b + (d + c)) + a.
Proof.
  intros a b c d.
  rewrite -> (plus_assoc c a b).
  rewrite -> (plus_comm (c + a + b) d).
  rewrite -> (plus_assoc d (c + a) b).
  rewrite -> (plus_assoc d c a).

  rewrite -> (plus_assoc b d c).
  rewrite -> (plus_comm (b + d + c) a).
  rewrite -> (plus_assoc a (b + d) c).
  rewrite -> (plus_assoc a b d).

  Admitted.

(* ********** *)

(* end of week_35.v *)


(** ** Null homotopies, an aid for proving things about propositional truncation *)

Require Export UniMath.Foundations.PartD.
Require Import UniMath.Foundations.UnivalenceAxiom.
Require Import UniMath.MoreFoundations.Tactics.
Require Import UniMath.MoreFoundations.Notations.

Local Open Scope transport.

Definition nullHomotopyTo {X Y} (f:X->Y) (y:Y) := ∏ x:X, f x = y.
Definition NullHomotopyTo {X Y} (f:X->Y) := total2 (nullHomotopyTo f).
Definition NullHomotopyTo_center {X Y} (f:X->Y) : NullHomotopyTo f -> Y := pr1.
Definition NullHomotopyTo_path {X Y} {f:X->Y} (r:NullHomotopyTo f) := pr2 r.

Definition nullHomotopyFrom {X Y} (f:X->Y) (y:Y) := ∏ x:X, y = f x.
Definition NullHomotopyFrom {X Y} (f:X->Y) := total2 (nullHomotopyFrom f).
Definition NullHomotopyFrom_center {X Y} (f:X->Y) : NullHomotopyFrom f -> Y := pr1.
Definition NullHomotopyFrom_path {X Y} {f:X->Y} (r:NullHomotopyFrom f) := pr2 r.

Definition nullHomotopyTo_transport {X Y} {f:X->Y} {y:Y} (h : nullHomotopyTo f y)
           {y':Y} (p:y = y') (x:X) : (p # h) x = h x @ p.
Proof.
  intros. induction p. apply pathsinv0. apply pathscomp0rid.
Defined.

Lemma isaset_NullHomotopyTo {X Y} (i:isaset Y) (f:X->Y) : isaset (NullHomotopyTo f).
Proof.
  intros. apply (isofhleveltotal2 2).
  { apply i. }
  intros y. apply impred; intros x. apply isasetaprop. apply i.
Defined.

Lemma isaprop_nullHomotopyTo {X Y} (is:isaset Y) (f:X->Y) (y:Y) :
  isaprop (nullHomotopyTo f y).
Proof.
  apply impred; intros x. apply is.
Defined.

Lemma isaprop_NullHomotopyTo {X} {Y} (is:isaset Y) (f:X->Y) :
  ∥ X ∥ -> isaprop (NullHomotopyTo f).
Proof.
  apply factor_through_squash.
  apply isapropisaprop.
  intros x. apply invproofirrelevance. intros [r i] [s j].
  apply subtypePairEquality.
  - intros n. apply (isaprop_nullHomotopyTo is).
  - exact (!i x @ j x).
Defined.

(* We can get a map from '∥ X ∥' to any type 'Y' provided paths
   are given that allow us to map first into a cone in 'Y'.  *)

Definition cone_squash_map {X Y} (f:X->Y) (y:Y) :
  nullHomotopyTo f y -> ∥ X ∥ -> Y.
Proof.
  intros e h. exact (point_from (h (paths_to_prop y) (λ x, f x,,e x))).
Defined.

Goal ∏ X Y (y:Y) (f:X->Y) (e:∏ m:X, f m = y),
       f = cone_squash_map f y e ∘ squash_element.
Proof.
  reflexivity.
Qed.

(*
Local Variables:
compile-command: "make -C ../.. TAGS UniMath/MoreFoundations/NullHomotopies.vo"
End:
*)


Require Export Coq.Lists.List Coq.Program.Program
        Fiat.QueryStructure.Implementation.DataStructures.Bags.BagsInterface
        Fiat.QueryStructure.Implementation.DataStructures.Bags.BagsProperties.
Require Import Fiat.Common.List.ListFacts.

Unset Implicit Arguments.

Section CachingBags.
(* This will need to be patched up to work with update and delete. *)
(*  Require Import SetEq.
  Require Import Morphisms.

  Context {TItem : Type}
          {TCachedValue : Type}
          (eqA: TCachedValue -> TCachedValue -> Prop)
          (updater: TItem -> TCachedValue -> TCachedValue)
          (initial_value: TCachedValue).

  Definition RecomputeCachedValue
             (items: list TItem) :=
    List.fold_right updater initial_value items.

  Definition CachedValueIsFresh
             (items: list TItem)
             (cached_value: TCachedValue) :=
    eqA (RecomputeCachedValue items) cached_value.

  Definition IsStronglyCacheable :=
    Proper (@SetEq TItem ==> eqA) RecomputeCachedValue.

  Definition IsCacheable :=
    Proper (@Permutation TItem ==> eqA) RecomputeCachedValue.

  Lemma is_cacheable_proper :
    IsCacheable ->
    Proper (eq ==> eqA ==> eqA) updater.
  Proof.
    unfold Proper, respectful.
    intros * cacheable * is_eq * is_eqA; subst.
    specialize (cacheable [y] [y]).

    simpl in cacheable. apply cacheable; trivial.
  Qed.

  Require Import Permutation.

  Record Cache
         {TBag TItem TSearchTerm TCachedValue: Type}
         {bag_bag: Bag TBag TItem TSearchTerm}
         {initial_value: TCachedValue}
         {eqA: TCachedValue -> TCachedValue -> Prop}
         {updater: TItem -> TCachedValue -> TCachedValue}
         {updater_cacheable: IsCacheable eqA updater} :=
    {
      cbag:          TBag;
      ccached_value: TCachedValue;
      cfresh_cache:  CachedValueIsFresh eqA initial_value updater (benumerate cbag) ccached_value
    }.

  (* Note: The caching interface provides the initial_value
         parameter to allow implementations to gracefully handle empty
         caches. Should an empty/non-empty distinction be needed,
         initial_value can be set to None, and TCachedValue
         replaced by an option type. *)

  Definition extract_cacheability_proof
             {TBag TItem TSearchTerm TCachedValue: Type}
             {bag_bag: Bag TBag TItem TSearchTerm}
             {initial_value: TCachedValue}
             {eqA: TCachedValue -> TCachedValue -> Prop}
             {updater: TItem -> TCachedValue -> TCachedValue}
             {updater_cacheable: IsCacheable eqA updater}
             (cache: @Cache TBag TItem TSearchTerm TCachedValue bag_bag initial_value eqA updater updater_cacheable) :=
    updater_cacheable.

  Lemma empty_caching_bag_fresh:
    forall {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag : Bag TBag TItem TSearchTerm}
           (initial_value : TCachedValue)
           {eqA: TCachedValue -> TCachedValue -> Prop}
           {equiv: Equivalence eqA}
           (updater : TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater),
      CachedValueIsFresh eqA initial_value updater (benumerate bempty) initial_value.
  Proof.
    intros; rewrite benumerate_empty_eq_nil; compute; reflexivity.
  Qed.

  Definition Cache_bempty
             {TBag TItem TSearchTerm TCachedValue: Type}
             {bag_bag : Bag TBag TItem TSearchTerm}
             (initial_value : TCachedValue)
             (eqA: TCachedValue -> TCachedValue -> Prop)
             (equiv: Equivalence eqA)
             (updater : TItem -> TCachedValue -> TCachedValue)
             (updater_cacheable: IsCacheable eqA updater) :
    (@Cache _ _ _ _ bag_bag initial_value eqA updater updater_cacheable) :=
    {|
      cbag          := @bempty _ _ _ bag_bag;
      ccached_value := initial_value;
      cfresh_cache  := empty_caching_bag_fresh initial_value
                                               updater updater_cacheable
    |}.

  Definition Cache_bstar
             {TBag TItem TSearchTerm: Type}
             {bag_bag : Bag TBag TItem TSearchTerm} :=
    bstar.

  Definition Cache_bfind_matcher
             {TBag TItem TSearchTerm TCachedValue: Type}
             {bag_bag : Bag TBag TItem TSearchTerm}
             (initial_value : TCachedValue)
             (eqA: TCachedValue -> TCachedValue -> Prop)
             (updater : TItem -> TCachedValue -> TCachedValue)
             (updater_cacheable: IsCacheable eqA updater)
             (search_term: TSearchTerm) (item: TItem) :=
    bfind_matcher search_term item.

  Definition Cache_benumerate
             {TBag TItem TSearchTerm TCachedValue: Type}
             {bag_bag: Bag TBag TItem TSearchTerm}
             (initial_value : TCachedValue)
             (eqA: TCachedValue -> TCachedValue -> Prop)
             (updater : TItem -> TCachedValue -> TCachedValue)
             (updater_cacheable: IsCacheable eqA updater)
             (container: @Cache _ _ _ _ bag_bag initial_value
                                eqA updater updater_cacheable) :=
    benumerate (cbag container).

  Definition Cache_bfind
             {TBag TItem TSearchTerm TCachedValue: Type}
             {bag_bag: Bag TBag TItem TSearchTerm}
             (initial_value : TCachedValue)
             (eqA: TCachedValue -> TCachedValue -> Prop)
             (updater : TItem -> TCachedValue -> TCachedValue)
             (updater_cacheable: IsCacheable eqA updater)
             (container: @Cache _ _ _ _ bag_bag initial_value
                                eqA updater updater_cacheable)
             (search_term: TSearchTerm) :=
    bfind (cbag container) search_term.

  Definition Cache_bcount
             {TBag TItem TSearchTerm TCachedValue: Type}
             {bag_bag: Bag TBag TItem TSearchTerm}
             (initial_value : TCachedValue)
             (eqA: TCachedValue -> TCachedValue -> Prop)
             (updater : TItem -> TCachedValue -> TCachedValue)
             (updater_cacheable: IsCacheable eqA updater)
             (container: @Cache _ _ _ _ bag_bag initial_value
                                eqA updater updater_cacheable)
             (search_term: TSearchTerm) :=
    bcount (cbag container) search_term.

  Lemma updated_cache_fresh_after_insert :
    forall {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag: Bag TBag TItem TSearchTerm}
           (initial_value: TCachedValue)
           (eqA: TCachedValue -> TCachedValue -> Prop)
           (equiv: Equivalence eqA)
           (updater: TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater)
           (container: @Cache _ _ _ _ bag_bag initial_value
                              eqA updater updater_cacheable)
           (item: TItem),
      CachedValueIsFresh eqA initial_value updater
                         (benumerate (binsert (cbag container) item))
                         (updater item (ccached_value container)).
  Proof.
    intros;
    unfold CachedValueIsFresh.
    unfold IsCacheable in updater_cacheable.
    rewrite binsert_enumerate.
    pose proof (is_cacheable_proper updater_cacheable).
    pose proof (@cfresh_cache) as fresh; unfold CachedValueIsFresh in fresh;
    simpl; rewrite fresh; reflexivity.
  Qed.

  Definition Cache_binsert
             {TBag TItem TSearchTerm TCachedValue: Type}
             {bag_bag: Bag TBag TItem TSearchTerm}
             (initial_value: TCachedValue)
             (eqA: TCachedValue -> TCachedValue -> Prop)
             (equiv: Equivalence eqA)
             (updater: TItem -> TCachedValue -> TCachedValue)
             (updater_cacheable: IsCacheable eqA updater)
             (container: @Cache TBag TItem TSearchTerm TCachedValue
                                bag_bag initial_value
                                eqA updater updater_cacheable)
             (item: TItem) : @Cache TBag TItem TSearchTerm TCachedValue
                                    bag_bag initial_value
                                    eqA updater updater_cacheable :=
    {|
      cbag          := binsert (Bag := bag_bag) (cbag container) item;
      ccached_value := updater item (ccached_value container);
      cfresh_cache  := updated_cache_fresh_after_insert _ _ _ _ _ _ _
    |}.

  (* We're just going to recompute the cached value in the interest of
   expediency. Future implementations will have more clever ways of
   doing this. *)
  Definition Cache_bdelete
             {TBag TItem TSearchTerm TCachedValue: Type}
             {bag_bag: Bag TBag TItem TSearchTerm}
             (initial_value: TCachedValue)
             (eqA: TCachedValue -> TCachedValue -> Prop)
             (equiv: Equivalence eqA)
             (updater: TItem -> TCachedValue -> TCachedValue)
             (updater_cacheable: IsCacheable eqA updater)
             (container: @Cache TBag TItem TSearchTerm TCachedValue
                                bag_bag initial_value
                                eqA updater updater_cacheable)
             (search_term : TSearchTerm) : @Cache TBag TItem TSearchTerm TCachedValue
                                                  bag_bag initial_value
                                                  eqA updater updater_cacheable :=
    let c := bdelete (Bag := bag_bag) (cbag container) search_term in
    {|
      cbag          := c;
      ccached_value := RecomputeCachedValue updater initial_value (benumerate c);
      cfresh_cache  := reflexivity _
    |}.

  (* We're just going to recompute the cached value in the interest of
   expediency. Future implementations will have more clever ways of
   doing this. *)
  Definition Cache_bupdate
             {TBag TItem TSearchTerm TCachedValue: Type}
             {bag_bag: Bag TBag TItem TSearchTerm}
             (initial_value: TCachedValue)
             (eqA: TCachedValue -> TCachedValue -> Prop)
             (equiv: Equivalence eqA)
             (updater: TItem -> TCachedValue -> TCachedValue)
             (updater_cacheable: IsCacheable eqA updater)
             (container: @Cache TBag TItem TSearchTerm TCachedValue
                                bag_bag initial_value
                                eqA updater updater_cacheable)
             (search_term : TSearchTerm)
             (update_f : TItem -> TItem)
  : @Cache TBag TItem TSearchTerm TCachedValue
           bag_bag initial_value
           eqA updater updater_cacheable :=
    let c := bupdate (Bag := bag_bag) (cbag container) search_term update_f in
    {|
      cbag          := c;
      ccached_value := RecomputeCachedValue updater initial_value (benumerate c);
      cfresh_cache  := reflexivity _
    |}.

  Ltac transparent_implementation :=
    unfold BagInsertEnumerate, BagEnumerateEmpty, BagFindStar,
    BagFindCorrect, BagCountCorrect, BagDeleteCorrect, BagUpdateCorrect;
    intros;
    first [ apply binsert_enumerate | apply benumerate_empty
            | apply bfind_correct | apply bfind_star
            | apply bcount_correct | apply bdelete_correct | apply bupdate_correct ].

  Lemma Cache_BagInsertEnumerate :
    forall {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag: Bag TBag TItem TSearchTerm}
           (initial_value: TCachedValue)
           (eqA: TCachedValue -> TCachedValue -> Prop)
           (equiv: Equivalence eqA)
           (updater: TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater),
      BagInsertEnumerate
        (Cache_benumerate initial_value eqA updater updater_cacheable)
        (Cache_binsert    initial_value eqA equiv updater updater_cacheable).
  Proof. transparent_implementation. Qed.

  Lemma Cache_BagEnumerateEmpty :
    forall {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag: Bag TBag TItem TSearchTerm}
           (initial_value: TCachedValue)
           (eqA: TCachedValue -> TCachedValue -> Prop)
           (equiv: Equivalence eqA)
           (updater: TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater),
      BagEnumerateEmpty
        (Cache_benumerate initial_value eqA updater updater_cacheable)
        (Cache_bempty     initial_value eqA equiv updater updater_cacheable).
  Proof. transparent_implementation. Qed.

  Lemma Cache_BagFindStar :
    forall {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag: Bag TBag TItem TSearchTerm}
           (initial_value: TCachedValue)
           (eqA: TCachedValue -> TCachedValue -> Prop)
           (updater: TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater),
      BagFindStar
        (Cache_bfind      initial_value eqA updater updater_cacheable)
        (Cache_benumerate initial_value eqA updater updater_cacheable)
        Cache_bstar.
  Proof. transparent_implementation. Qed.

  Lemma Cache_BagFindCorrect :
    forall {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag: Bag TBag TItem TSearchTerm}
           (initial_value: TCachedValue)
           (eqA: TCachedValue -> TCachedValue -> Prop)
           (updater: TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater),
      BagFindCorrect
        (Cache_bfind         initial_value eqA updater updater_cacheable)
        (Cache_bfind_matcher initial_value eqA updater updater_cacheable)
        (Cache_benumerate    initial_value eqA updater updater_cacheable).
  Proof. transparent_implementation. Qed.

  Lemma Cache_BagCountCorrect :
    forall {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag: Bag TBag TItem TSearchTerm}
           (initial_value: TCachedValue)
           (eqA: TCachedValue -> TCachedValue -> Prop)
           (updater: TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater),
      BagCountCorrect
        (Cache_bcount initial_value eqA updater updater_cacheable)
        (Cache_bfind  initial_value eqA updater updater_cacheable).
  Proof. transparent_implementation. Qed.

  Lemma Cache_BagDeleteCorrect :
    forall {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag: Bag TBag TItem TSearchTerm}
           (initial_value: TCachedValue)
           (eqA: TCachedValue -> TCachedValue -> Prop)
           (equiv: Equivalence eqA)
           (updater: TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater),
      BagDeleteCorrect (Cache_bfind initial_value eqA updater updater_cacheable)
                       (Cache_bfind_matcher initial_value eqA updater updater_cacheable)
                       (Cache_benumerate initial_value eqA updater updater_cacheable)
                       (Cache_bdelete initial_value eqA equiv updater updater_cacheable).
  Proof. transparent_implementation. Qed.

  Lemma Cache_BagUpdateCorrect :
    forall {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag: Bag TBag TItem TSearchTerm}
           (initial_value: TCachedValue)
           (eqA: TCachedValue -> TCachedValue -> Prop)
           (equiv: Equivalence eqA)
           (updater: TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater),
      BagUpdateCorrect (Cache_bfind initial_value eqA updater updater_cacheable)
                       (Cache_bfind_matcher initial_value eqA updater updater_cacheable)
                       (Cache_benumerate initial_value eqA updater updater_cacheable)
                       (Cache_bupdate initial_value eqA equiv updater updater_cacheable).
  Proof. transparent_implementation. Qed.

  Instance CacheAsBag
           {TBag TItem TSearchTerm TCachedValue: Type}
           {bag_bag: Bag TBag TItem TSearchTerm}
           (initial_value: TCachedValue)
           (eqA: TCachedValue -> TCachedValue -> Prop)
           (equiv: Equivalence eqA)
           (updater: TItem -> TCachedValue -> TCachedValue)
           (updater_cacheable: IsCacheable eqA updater)
  : Bag (@Cache _ _ _ _ bag_bag initial_value
                eqA updater updater_cacheable)
        TItem TSearchTerm :=
    {|
      bempty        := Cache_bempty initial_value eqA equiv updater updater_cacheable;
      bstar         := Cache_bstar;
      bfind_matcher := Cache_bfind_matcher initial_value eqA updater updater_cacheable;

      benumerate := Cache_benumerate initial_value eqA updater updater_cacheable;
      bfind      := Cache_bfind      initial_value eqA updater updater_cacheable;
      binsert    := Cache_binsert    initial_value eqA equiv updater updater_cacheable;
      bcount     := Cache_bcount     initial_value eqA updater updater_cacheable;
      bdelete    := Cache_bdelete     initial_value eqA equiv updater updater_cacheable;
      bupdate    := Cache_bupdate    initial_value eqA equiv updater updater_cacheable;

      binsert_enumerate := Cache_BagInsertEnumerate initial_value eqA equiv updater updater_cacheable;
      benumerate_empty  := Cache_BagEnumerateEmpty  initial_value eqA equiv updater updater_cacheable;
      bfind_star        := Cache_BagFindStar        initial_value eqA updater updater_cacheable;
      bfind_correct     := Cache_BagFindCorrect     initial_value eqA updater updater_cacheable;
      bcount_correct    := Cache_BagCountCorrect    initial_value eqA updater updater_cacheable;
      bdelete_correct   := Cache_BagDeleteCorrect   initial_value eqA equiv updater updater_cacheable;
      bupdate_correct   := Cache_BagUpdateCorrect   initial_value eqA equiv updater updater_cacheable
    |}.

  Section CacheableFunctions.
    Section Generalities.
      Lemma projection_cacheable :
        forall {TItem TCacheUpdaterInput TCachedValue}
               (projection: TItem -> TCacheUpdaterInput)
               (eqA: TCachedValue -> TCachedValue -> Prop)
               (updater: TCacheUpdaterInput -> TCachedValue -> TCachedValue),
          IsCacheable eqA updater ->
          IsCacheable eqA (compose updater projection).
      Proof.
        unfold IsCacheable, Proper, respectful.
        intros * is_cacheable * is_eqA * is_perm.
        unfold RecomputeCachedValue in *.
        rewrite !foldright_compose;
          apply is_cacheable;
          try rewrite is_perm;
          eauto.
      Qed.

      Require Import SetEqProperties.
      Lemma projection_strongly_cacheable :
        forall {TItem TCacheUpdaterInput TCachedValue}
               (projection: TItem -> TCacheUpdaterInput)
               (eqA: TCachedValue -> TCachedValue -> Prop)
               (updater: TCacheUpdaterInput -> TCachedValue -> TCachedValue),
          IsStronglyCacheable eqA updater ->
          IsStronglyCacheable eqA (compose updater projection).
      Proof.
        unfold IsStronglyCacheable, Proper, respectful.
        intros * is_cacheable * is_eqA * is_set_eq.
        unfold RecomputeCachedValue in *.
        rewrite !foldright_compose;
          apply is_cacheable;
          try rewrite is_set_eq;
          eauto using SetEq_Reflexive.
      Qed.

      Lemma strongly_cacheable_cacheable :
        forall {TItem TCachedValue} eqA f,
          @IsStronglyCacheable TItem TCachedValue eqA f -> IsCacheable eqA f.
      Proof.
        unfold IsCacheable, IsStronglyCacheable, SetEq, Proper, respectful; intros * set_eq * is_eqA * perm.
        apply set_eq; try assumption; setoid_rewrite perm; reflexivity.
      Qed.

      Definition AddCachingLayer
                 {TBag TItem TSearchTerm TCacheUpdaterInput TCachedValue: Type}
                 (bag_bag: Bag TBag TItem TSearchTerm)
                 (cache_projection: TItem -> TCacheUpdaterInput)
                 (initial_value: TCachedValue)
                 (eqA: TCachedValue -> TCachedValue -> Prop)
                 (equiv: Equivalence eqA)
                 (updater: TCacheUpdaterInput -> TCachedValue -> TCachedValue)
                 (updater_cacheable: IsCacheable eqA updater) :=
        {|
          BagType       :=  @Cache TBag TItem TSearchTerm TCachedValue
                                   bag_bag initial_value
                                   eqA (compose updater cache_projection)
                                   (projection_cacheable cache_projection
                                                         eqA updater
                                                         updater_cacheable);
          SearchTermType := TSearchTerm;
          BagProof       := _
        |}.

      Definition CacheImplementationEnsures
                 {TCacheUpdaterInput TCachedValue}
                 (cache_property: (TCacheUpdaterInput -> TCacheUpdaterInput) ->
                                  list TCacheUpdaterInput ->
                                  TCacheUpdaterInput ->
                                  TCachedValue ->
                                  Prop)
                 (initial_value: TCachedValue)
                 (updater: TCacheUpdaterInput -> TCachedValue -> TCachedValue) : Prop :=
        forall seq (value: TCacheUpdaterInput),
          cache_property (@id TCacheUpdaterInput) seq value
                         (RecomputeCachedValue updater initial_value seq).

      Definition ProjectedCacheImplementationEnsures_strong
                 {TItem TCacheUpdaterInput TCachedValue}
                 (cache_property : (TCacheUpdaterInput -> TCacheUpdaterInput) ->
                                   list TCacheUpdaterInput ->
                                   TCacheUpdaterInput ->
                                   TCachedValue ->
                                   Prop)
                 (initial_value: TCachedValue)
                 (updater: TCacheUpdaterInput -> TCachedValue -> TCachedValue)
                 (projection: TItem -> TCacheUpdaterInput) :=
        forall seq (item: TItem),
          cache_property (@id TCacheUpdaterInput) (List.map projection seq) (projection item)
                         (RecomputeCachedValue (compose updater projection) initial_value seq).

      Definition ProjectedCacheImplementationEnsures
                 {TItem TCacheUpdaterInput TCachedValue}
                 (cache_property : (TItem -> TCacheUpdaterInput) ->
                                   list TItem ->
                                   TItem ->
                                   TCachedValue ->
                                   Prop)
                 (initial_value: TCachedValue)
                 (updater: TCacheUpdaterInput -> TCachedValue -> TCachedValue)
                 (projection: TItem -> TCacheUpdaterInput) :=
        forall seq (item: TItem),
          cache_property projection seq item
                         (RecomputeCachedValue (compose updater projection) initial_value seq).

      Lemma generalize_to_projection :
        forall {TItem TCacheUpdaterInput TCachedValue}
               {updater: TCacheUpdaterInput -> TCachedValue -> TCachedValue}
               (projection: TItem -> TCacheUpdaterInput)
               (initial_value: TCachedValue)
               (cache_property: (TCacheUpdaterInput -> TCacheUpdaterInput) ->
                                list TCacheUpdaterInput ->
                                TCacheUpdaterInput ->
                                TCachedValue ->
                                Prop),
          (CacheImplementationEnsures
             cache_property initial_value updater) ->
          (ProjectedCacheImplementationEnsures_strong
             cache_property initial_value updater projection).
      Proof.
        unfold CacheImplementationEnsures, ProjectedCacheImplementationEnsures_strong, RecomputeCachedValue;
        intros * non_projected_proof *;
        rewrite foldright_compose in *;
        apply non_projected_proof.
      Qed.

      Lemma assert_cache_property :
        forall {TItem TCacheUpdaterInput TCachedValue: Type},
        forall {updater: TCacheUpdaterInput -> TCachedValue -> TCachedValue}
               {projection: TItem -> TCacheUpdaterInput}
               {eqA: TCachedValue -> TCachedValue -> Prop}
               {cached_value: TCachedValue}
               {cache_property},
        forall {seq: list TItem} {initial_value: TCachedValue},
          CachedValueIsFresh eqA initial_value (compose updater projection) seq cached_value ->
          ProjectedCacheImplementationEnsures cache_property initial_value updater projection ->
          Proper (eq ==> eqA ==> iff) (cache_property projection seq) ->
          forall item,
            cache_property projection seq item cached_value.
      Proof.
        intros * fresh_cache impl_ensures * proper *.
        rewrite <- fresh_cache.
        apply impl_ensures.
      Qed.

      Lemma eq_always_proper_for_cache_properties :
        forall {TCacheUpdaterInput TCachedValue} {projection} {seq}
               (cache_property: (TCacheUpdaterInput -> TCacheUpdaterInput) ->
                                list TCacheUpdaterInput ->
                                TCacheUpdaterInput ->
                                TCachedValue ->
                                Prop),
          Proper (eq ==> eq ==> iff) (cache_property projection seq).
      Proof.
        unfold Proper, respectful; intros; subst; reflexivity.
      Qed.
    End Generalities.

    Section MaxCacheable.
      Definition IsMax m seq :=
        (forall x, List.In x seq -> x <= m) /\ List.In m seq.

      Require Import Setoid.
      Add Parametric Morphism (m: nat) :
        (IsMax m)
          with signature (@SetEq nat ==> iff)
            as IsMax_morphism.
      Proof.
        firstorder.
      Qed.

      Definition ListMax default seq :=
        List.fold_right max default seq.

      Lemma ListMax_correct_nil :
        forall seq default,
          seq = nil -> ListMax default seq = default.
      Proof.
        unfold ListMax; intros; subst; intuition.
      Qed.

      Lemma ListMax_correct :
        forall seq default,
          IsMax (ListMax default seq) (default :: seq).
      Proof.
        unfold IsMax;
        induction seq as [ | head tail IH ];
        intros; simpl.

        intuition.

        specialize (IH default);
          destruct IH as (sup & in_seq).

        split.

        intros x [ eq | [ eq | in_tail ] ].

        apply le_r_le_max, sup; simpl; intuition.
        apply le_l_le_max; subst; intuition.
        apply le_r_le_max, sup; simpl; intuition.

        destruct in_seq as [ max_default | max_in_tail ].

        rewrite <- max_default, Max.max_comm;
          destruct (Max.max_spec default head);
          intuition.

        match goal with
          | [ |- context[ max ?a ?b ] ] =>
            destruct (Max.max_spec a b)
              as [ (comp & max_eq) | (comp & max_eq) ]
        end; rewrite max_eq; intuition.
      Qed.

      Lemma Max_unique :
        forall {x y} seq,
          IsMax x seq ->
          IsMax y seq ->
          x = y.
      Proof.
        unfold IsMax;
        intros x y seq (x_sup & x_in) (y_sup & y_in);
        specialize (x_sup _ y_in);
        specialize (y_sup _ x_in);
        apply Le.le_antisym; assumption.
      Qed.

      Lemma ListMax_strongly_cacheable :
        IsStronglyCacheable eq max.
      Proof.
        unfold IsStronglyCacheable.

        intros init1 init2 eq12 seq1 seq2 set_eq; subst;
        apply (Max_unique (init2 :: seq1));
        [ | setoid_rewrite (SetEq_append init2 set_eq) ];
        apply ListMax_correct.
      Qed.

      Lemma ListMax_cacheable :
        IsCacheable eq max.
      Proof.
        intros; apply strongly_cacheable_cacheable.
        apply ListMax_strongly_cacheable.
      Qed.

      Definition cached_gt_property {TItem} (projection: TItem -> nat) seq value cached :=
        List.In value seq -> S cached > projection value.

      Definition cached_neq_property {TItem} (projection: TItem -> nat) seq value cached :=
        List.In value seq -> S cached <> projection value.

      Lemma max_cached_gt :
        forall default,
          CacheImplementationEnsures cached_gt_property default max.
      Proof.
        unfold CacheImplementationEnsures, cached_gt_property;
        intros;
        destruct (ListMax_correct seq default) as (sup & _);
        apply Gt.le_gt_S, sup;
        simpl; auto.
      Qed.

      Lemma max_cached_gt_projected {TItem} {projection} {default} :
        ProjectedCacheImplementationEnsures (TItem := TItem) cached_gt_property default max projection.
      Proof.
        unfold
          ProjectedCacheImplementationEnsures_strong,
        ProjectedCacheImplementationEnsures,
        cached_gt_property in *;
        intros;
        apply (generalize_to_projection projection default cached_gt_property (max_cached_gt default));
        apply in_map_unproject;
        assumption.
      Qed.

      Lemma max_cached_neq_projected {TItem} {projection} {default} :
        ProjectedCacheImplementationEnsures (TItem := TItem) cached_neq_property default max projection.
      Proof.
        unfold
          ProjectedCacheImplementationEnsures,
        cached_neq_property in *;
        intros;
        apply gt_neq_impl, max_cached_gt_projected;
        assumption.
      Qed.
    End MaxCacheable.
  End CacheableFunctions. *)
End CachingBags.


Require Export euclidean__axioms.
Require Export euclidean__defs.
Require Export euclidean__tactics.
Require Export lemma__extension.
Require Export lemma__inequalitysymmetric.
Require Export logic.
Definition lemma__samesidereflexive : forall A B P, (euclidean__axioms.nCol A B P) -> (euclidean__defs.OS P P A B).
Proof.
intro A.
intro B.
intro P.
intro H.
assert (* Cut *) (A = A) as H0.
- apply (@logic.eq__refl Point A).
- assert (* Cut *) (~(P = A)) as H1.
-- intro H1.
assert (* Cut *) (euclidean__axioms.Col A B A) as H2.
--- right.
left.
exact H0.
--- assert (* Cut *) (euclidean__axioms.Col A B P) as H3.
---- apply (@eq__ind__r euclidean__axioms.Point A (fun P0 => (euclidean__axioms.nCol A B P0) -> (euclidean__axioms.Col A B P0))) with (x := P).
-----intro H3.
exact H2.

----- exact H1.
----- exact H.
---- apply (@euclidean__tactics.Col__nCol__False A B P H H3).
-- assert (* Cut *) (euclidean__axioms.neq A P) as H2.
--- apply (@lemma__inequalitysymmetric.lemma__inequalitysymmetric P A H1).
--- assert (* Cut *) (exists C, (euclidean__axioms.BetS P A C) /\ (euclidean__axioms.Cong A C A P)) as H3.
---- apply (@lemma__extension.lemma__extension P A A P H1 H2).
---- destruct H3 as [C H4].
destruct H4 as [H5 H6].
assert (* Cut *) (euclidean__axioms.Col A B A) as H7.
----- right.
left.
exact H0.
----- assert (* Cut *) (euclidean__defs.OS P P A B) as H8.
------ exists C.
exists A.
exists A.
split.
------- exact H7.
------- split.
-------- exact H7.
-------- split.
--------- exact H5.
--------- split.
---------- exact H5.
---------- split.
----------- exact H.
----------- exact H.
------ exact H8.
Qed.


Set Warnings "-notation-overridden".

From Coq Require Import ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Require Export Category.Theory.
Require Import Category.Lib.
Require Export Category.Theory.Category.
Require Import Category.Structure.Initial.
Require Import Category.Structure.Terminal.
Require Import CatQM.Monoidal.

Generalizable All Variables.
Set Primitive Projections.
Set Universe Polymorphism.
Unset Transparent Obligations.

Section Zero.

Context {C : Category}.

Class Zero := {
    terminal :> @Terminal C;
    initial :> @Initial C;
    terminal_initial_iso : 0 ≈ 1
}.

End Zero.

Definition from_zero `{T : @Zero C} {X} : 0 ~{C}~> X := @zero C initial _.
Definition to_zero `{T : @Zero C} {X} : X ~> 0 := terminal_initial_iso⁻¹ ∘ one.
Definition through_zero `{T : @Zero C} {X Y : C} : X ~{C}~> Y := (from_zero (X:=Y)) ∘ (to_zero (X:=X)).

Lemma to_zero_unique `{T : @Zero C} {X : C} (f g : X ~> 0) : f ≈ g.
Proof.
     have H : (terminal_initial_iso ∘ f ≈ terminal_initial_iso ∘ g).
        by apply one_unique.
    by exact (@monic _ _ _ _(iso_to_monic terminal_initial_iso) X f g H).
Qed.

Global Program Definition zero_tensor_zero `{M : @Monoidal C} `{T : @Zero C} : 0 ⨂ 0 ≅ (0 : C) := {|
    to := (unit_left (x:=0)) ∘ ((from_zero (X:=I)) ⨂ id{C});
    from := ((to_zero (X:=I)) ⨂ id{C}) ∘ (unit_left (x:=0))⁻¹
|}.
Next Obligation.
    rewrite <- comp_assoc, -> (comp_assoc _ unit_left _).
    rewrite -> iso_from_to, -> id_left.
    rewrite <- interchange_law.
    rewrite -> id_right, -> (to_zero_unique (to_zero ∘ from_zero) id).
    rewrite -> bimap_id_id; reflexivity.
Defined.

Lemma comp_through_zero_r `{T : @Zero C} {X Y Z : C} (f : Y ~> Z) : f ∘ through_zero ≈ (through_zero (X:=X) (Y:=Z)).
Proof.
    rewrite /through_zero; rewrite -> comp_assoc.
    rewrite -> (zero_unique (f ∘ from_zero)); reflexivity.
Qed.

Lemma comp_through_zero_l `{T : @Zero C} {X Y Z : C} (f : X ~> Y) : through_zero ∘ f ≈ (through_zero (X:=X) (Y:=Z)).
Proof.
    rewrite /through_zero; rewrite <- comp_assoc.
    rewrite -> to_zero_unique; reflexivity.
Qed.


(*
Require Import Category6.
Require Import Setoids.

Definition setoidsAsCategory : Category := category
    Setoid
    Map
    (@compose)
    id
    MapEq
    id_left
    id_right
    compose_assoc
    composition_is_compat.
*)


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2010     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(*********************************************************)
(**    Axiomatisation of the classical reals             *)
(*********************************************************)

Require Export ZArith_base.
Require Export Rdefinitions.
Open Local Scope R_scope.

(*********************************************************)
(** *            Field axioms                            *)
(*********************************************************)

(*********************************************************)
(** **   Addition                                        *)
(*********************************************************)

(**********)
Axiom Rplus_comm : forall r1 r2:R, r1 + r2 = r2 + r1.
Hint Resolve Rplus_comm: real.

(**********)
Axiom Rplus_assoc : forall r1 r2 r3:R, r1 + r2 + r3 = r1 + (r2 + r3).
Hint Resolve Rplus_assoc: real.

(**********)
Axiom Rplus_opp_r : forall r:R, r + - r = 0.
Hint Resolve Rplus_opp_r: real v62.

(**********)
Axiom Rplus_0_l : forall r:R, 0 + r = r.
Hint Resolve Rplus_0_l: real.

(***********************************************************)
(** **    Multiplication                                   *)
(***********************************************************)

(**********)
Axiom Rmult_comm : forall r1 r2:R, r1 * r2 = r2 * r1.
Hint Resolve Rmult_comm: real v62.

(**********)
Axiom Rmult_assoc : forall r1 r2 r3:R, r1 * r2 * r3 = r1 * (r2 * r3).
Hint Resolve Rmult_assoc: real v62.

(**********)
Axiom Rinv_l : forall r:R, r <> 0 -> / r * r = 1.
Hint Resolve Rinv_l: real.

(**********)
Axiom Rmult_1_l : forall r:R, 1 * r = r.
Hint Resolve Rmult_1_l: real.

(**********)
Axiom R1_neq_R0 : 1 <> 0.
Hint Resolve R1_neq_R0: real.

(*********************************************************)
(** **   Distributivity                                  *)
(*********************************************************)

(**********)
Axiom
  Rmult_plus_distr_l : forall r1 r2 r3:R, r1 * (r2 + r3) = r1 * r2 + r1 * r3.
Hint Resolve Rmult_plus_distr_l: real v62.

(*********************************************************)
(** *    Order axioms                                    *)
(*********************************************************)
(*********************************************************)
(** **   Total Order                                     *)
(*********************************************************)

(**********)
Axiom total_order_T : forall r1 r2:R, {r1 < r2} + {r1 = r2} + {r1 > r2}.

(*********************************************************)
(** **   Lower                                           *)
(*********************************************************)

(**********)
Axiom Rlt_asym : forall r1 r2:R, r1 < r2 -> ~ r2 < r1.

(**********)
Axiom Rlt_trans : forall r1 r2 r3:R, r1 < r2 -> r2 < r3 -> r1 < r3.

(**********)
Axiom Rplus_lt_compat_l : forall r r1 r2:R, r1 < r2 -> r + r1 < r + r2.

(**********)
Axiom
  Rmult_lt_compat_l : forall r r1 r2:R, 0 < r -> r1 < r2 -> r * r1 < r * r2.

Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real.

(**********************************************************)
(** *    Injection from N to R                            *)
(**********************************************************)

(**********)
Fixpoint INR (n:nat) : R :=
  match n with
  | O => 0
  | S O => 1
  | S n => INR n + 1
  end.
Arguments Scope INR [nat_scope].

(**********************************************************)
(** *    Injection from [Z] to [R]                        *)
(**********************************************************)

(**********)
Definition IZR (z:Z) : R :=
  match z with
  | Z0 => 0
  | Zpos n => INR (nat_of_P n)
  | Zneg n => - INR (nat_of_P n)
  end.
Arguments Scope IZR [Z_scope].

(**********************************************************)
(** *    [R] Archimedean                                  *)
(**********************************************************)

(**********)
Axiom archimed : forall r:R, IZR (up r) > r /\ IZR (up r) - r <= 1.

(**********************************************************)
(** *    [R] Complete                                     *)
(**********************************************************)

(**********)
Definition is_upper_bound (E:R -> Prop) (m:R) := forall x:R, E x -> x <= m.

(**********)
Definition bound (E:R -> Prop) :=  exists m : R, is_upper_bound E m.

(**********)
Definition is_lub (E:R -> Prop) (m:R) :=
  is_upper_bound E m /\ (forall b:R, is_upper_bound E b -> m <= b).

(**********)
Axiom
  completeness :
    forall E:R -> Prop,
      bound E -> (exists x : R, E x) -> { m:R | is_lub E m }.


Require Import init.

Require Import category_base.

Require Import set.

(* begin show *)
Local Program Instance TYPE : Category := {
    cat_U := Type;
    cat_morphism A B := A → B;
    cat_compose A B C f g := λ x, f (g x);
    cat_id A := (@identity A);
}.
(* end show *)

Theorem set_category_isomorphism : ∀ {A B} (f : cat_morphism TYPE A B),
    isomorphism f → Bijective f.
Proof.
    intros A B f [g [g_eq1 g_eq2]].
    cbn in *.
    assert (∀ x, f (g x) = x) as f_eq1.
    {
        intros x.
        exact (func_eq _ _ g_eq1 x).
    }
    assert (∀ x, g (f x) = x) as f_eq2.
    {
        intros x.
        exact (func_eq _ _ g_eq2 x).
    }
    split; split.
    -   intros a b eq.
        apply (f_equal g) in eq.
        do 2 rewrite f_eq2 in eq.
        exact eq.
    -   intros y.
        exists (g y).
        apply f_eq1.
Qed.

(* begin show *)
Local Program Instance SINGLETON : Category := {
    cat_U := singleton_type;
    cat_morphism A B := singleton_type;
    cat_compose A B C f g := Single;
    cat_id A := Single;
}.
(* end show *)
Next Obligation.
    apply singleton_type_eq.
Qed.
Next Obligation.
    apply singleton_type_eq.
Qed.


Require Import Coq.Classes.Morphisms.
Require Import Coq.Lists.List.
Require Import CertiGraph.lib.Coqlib.
Require Import CertiGraph.lib.List_ext.
Require Import CertiGraph.lib.List_Func_ext.
Require Export CertiGraph.lib.Relation_ext.

(* TODO: define a general pointwise relation on list *)
Inductive same_relation_list {A: Type}: list (relation A) -> list (relation A) -> Prop :=
  | same_relation_list_nil :
      same_relation_list nil nil
  | same_relation_list_cons :
      forall x xs y ys,
      same_relation A x y ->
      same_relation_list xs ys ->
      same_relation_list (x :: xs) (y :: ys).

Lemma same_relation_list_refl: forall {A} (rs: list (relation A)), same_relation_list rs rs.
Proof.
  intros.
  induction rs; constructor; auto.
  reflexivity.
Qed.

Lemma same_relation_list_symm: forall {A} (rs1 rs2: list (relation A)),
  same_relation_list rs1 rs2 -> same_relation_list rs2 rs1.
Proof.
  intros.
  induction H; constructor.
  + symmetry; auto.
  + auto.
Qed.

Lemma same_relation_list_trans: forall {A} (rs1 rs2 rs3: list (relation A)),
  same_relation_list rs1 rs2 ->
  same_relation_list rs2 rs3 ->
  same_relation_list rs1 rs3.
Proof.
  intros.
  rename H0 into HH.
  revert rs3 HH; induction H; intros;
  inversion HH; subst; constructor.
  + rewrite H; auto.
  + auto.
Qed.

#[export] Instance Equivalence_same_relation_list {A}: Equivalence (@same_relation_list A).
Proof.
  split.
  + exact same_relation_list_refl.
  + exact same_relation_list_symm.
  + exact same_relation_list_trans.
Defined.

#[export] Instance cons_relation_proper {A}: Proper (same_relation A ==> same_relation_list ==> same_relation_list) (@cons (relation A)).
Proof.
  do 2 (hnf; intros).
  apply same_relation_list_cons; auto.
Defined.

Definition relation_list {A: Type} (R: list (relation A)) : relation A := fold_left compond_relation R eq.

Lemma relation_list_app: forall {A: Type} (R R': list (relation A)),
  same_relation _ (relation_list (R ++ R')) (compond_relation (relation_list R) (relation_list R')).
Proof.
  intros.
  apply monoid_fold_left_app.
  + apply compond_eq_left.
  + apply compond_eq_right.
  + apply compond_assoc.
Qed.

Lemma relation_list_head: forall {A: Type} a (l: list (relation A)),
  same_relation _ (relation_list (a :: l)) (compond_relation a (relation_list l)).
Proof.
  intros.
  apply monoid_fold_left_head.
  + apply compond_eq_left.
  + apply compond_eq_right.
  + apply compond_assoc.
Qed.

Lemma relation_list_tail: forall {A: Type} (l: list (relation A)) a,
  same_relation _ (relation_list (l ++ a :: nil)) (compond_relation (relation_list l) a).
Proof.
  intros.
  apply monoid_fold_left_tail.
Qed.

Lemma relation_list_nil: forall {A}, same_relation A (relation_list nil) eq.
Proof.
  intros.
  reflexivity.
Qed.

Lemma eq_relation_list: forall {A B} {R: relation A} {EqRA: Equivalence R} (l: list B),
  inclusion _ (relation_list (map (fun _ => R) l)) R.
Proof.
  intros.
  induction l.
  + simpl; rewrite relation_list_nil.
    hnf; intros.
    subst; reflexivity.
  + simpl map.
    rewrite relation_list_head.
    hnf; intros.
    inversion H; subst.
    transitivity y0.
    - auto.
    - apply IHl; auto.
Qed.

Lemma relation_list_weaken_ind: forall {A B} (R R': B -> relation A) l a1 a2,
  (forall bs_done b0 a2 a3,
     In (bs_done, b0) (cprefix l) ->
     relation_list (map R bs_done) a1 a2 ->
     R b0 a2 a3 ->
     R' b0 a2 a3) ->
  relation_list (map R l) a1 a2 ->
  relation_list (map R' l) a1 a2.
Proof.
  intros.
  revert a2 H0; rev_induction l; intros.
  + simpl in H0 |- *; auto.
  + revert H1.
    rewrite !map_app; simpl.
    erewrite !(app_same_relation (relation_list _)) by apply relation_list_tail.
    intro.
    destruct H1.
    apply compond_intro with y.
    - apply H; auto.
      clear - H0.
      intros; apply (H0 bs_done); auto.
      rewrite combine_prefixes_app_1.
      apply in_app_iff.
      left; auto.
    - apply (H0 l); auto.
      rewrite combine_prefixes_app_1.
      apply in_app_iff.
      right; simpl; auto.
Qed.

Lemma relation_list_weaken_ind': forall {A B} (R R': B -> relation A) l a1 a2,
  (forall bs_done b0 a2 a3,
     In (bs_done, b0) (cprefix l) ->
     relation_list (map R bs_done) a1 a2 ->
     relation_list (map R' bs_done) a1 a2 ->
     R b0 a2 a3 ->
     R' b0 a2 a3) ->
  relation_list (map R l) a1 a2 ->
  relation_list (map R' l) a1 a2.
Proof.
  intros.
  revert a2 H0; rev_induction l; intros.
  + simpl in H0 |- *; auto.
  + revert H1.
    rewrite !map_app; simpl.
    erewrite !(app_same_relation (relation_list _)) by apply relation_list_tail.
    intro.
    destruct H1.
    assert (relation_list (map R' l) x0 y).
    - apply H; auto.
      clear - H0.
      intros; apply (H0 bs_done); auto.
      rewrite combine_prefixes_app_1.
      apply in_app_iff.
      left; auto.
    - apply compond_intro with y; auto.
      apply (H0 l); auto.
      rewrite combine_prefixes_app_1.
      apply in_app_iff.
      right; simpl; auto.
Qed.

Lemma relation_list_inclusion: forall {A B} (R R': B -> relation A) l,
  (forall b, In b l -> inclusion _ (R b) (R' b)) ->
  inclusion _ (relation_list (map R l)) (relation_list (map R' l)).
Proof.
  intros.
  induction l.
  + simpl.
    hnf; auto.
  + simpl map.
    rewrite relation_list_head.
    rewrite relation_list_head.
    apply compond_relation_inclusion.
    - apply H; simpl; auto.
    - apply IHl; intros.
      apply H; simpl; auto.
Qed.

Lemma relation_list_conjunction: forall {A B} (R R': B -> relation A) l,
  inclusion _ (relation_list (map (fun b => relation_conjunction (R b) (R' b)) l)) (relation_conjunction (relation_list (map R l)) (relation_list (map R' l))).
Proof.
  intros.
  simpl.
  induction l.
  - simpl.
    rewrite relation_list_nil.
    hnf; intros.
    rewrite relation_conjunction_iff.
    auto.
  - simpl map.
    rewrite !relation_list_head.
    hnf; intros.
    inv H.
    apply IHl in H1.
    rewrite relation_conjunction_iff.
    destruct H0, H1.
    split; apply compond_intro with y0; auto.
Qed.

Lemma respectful_relation_list: forall {B A} (f: B -> A) (l: list (relation A)),
  inclusion _
   (relation_list (map (respectful_relation f) l))
   (respectful_relation f (relation_list l)).
Proof.
  intros; hnf; intros.
  revert x y H; induction l; intros.
  + unfold relation_list in H.
    simpl in *.
    subst.
    reflexivity.
  + simpl.
    erewrite app_same_relation by (rewrite relation_list_head; reflexivity).
    apply respectful_compond_relation.
    simpl in H.
    erewrite app_same_relation in H by (rewrite relation_list_head; reflexivity).
    inversion H; subst.
    apply compond_intro with y0; auto.
Qed.

Lemma relation_list_singleton: forall {A} (R: relation A), same_relation _ (relation_list (R :: nil)) R.
Proof.
  intros.
  unfold relation_list; simpl.
  apply compond_eq_left.
Qed.

#[export] Instance relation_list_proper {A: Type}: Proper (same_relation_list ==> same_relation A) relation_list.
Proof.
  hnf; intros.
  induction H.
  + reflexivity.
  + rewrite !relation_list_head.
    rewrite H.
    rewrite IHsame_relation_list.
    reflexivity.
Qed.

Ltac split_relation_list L :=
  match goal with
  | |- relation_list _ ?x ?z =>
         match L with
         | nil =>
            try rewrite ((proj1 (same_relation_spec _ _) (relation_list_singleton _)) x z)
         | ?y :: ?L0 =>
            rewrite ((proj1 (same_relation_spec _ _) (relation_list_head _ _)) x z);
            apply compond_intro with y; [| split_relation_list L0]
         end
  end.

Ltac destruct_relation_list_aux cont H x z L :=
  match L with
  | ?A :: ?L0 =>
     match L0 with
     | _ :: _ =>
         fun y =>
         destruct_relation_list_aux ltac:(cont;
           rewrite ((proj1 (same_relation_spec _ _) (relation_list_head _ _)) x z) in H;
           let HH := fresh "H" in
           apply compond_relation_spec in H; destruct H as [y [HH H]]) H y z L0
     | _ => cont;
         try rewrite ((proj1 (same_relation_spec _ _) (relation_list_singleton _)) x z) in H
     end
  | _ => cont
  end.

Ltac destruct_relation_list' H :=
  match type of H with
  | relation_list ?L ?x ?z => destruct_relation_list_aux idtac H x z L
  end.

Tactic Notation "destruct_relation_list" ident(x0) "in" hyp(H) := destruct_relation_list' H x0.
Tactic Notation "destruct_relation_list" ident(x0) ident(x1) "in" hyp(H) := destruct_relation_list' H x0 x1.
Tactic Notation "destruct_relation_list" ident(x0) ident(x1) ident(x2) "in" hyp(H) := destruct_relation_list' H x0 x1 x2.
Tactic Notation "destruct_relation_list" ident(x0) ident(x1) ident(x2) ident(x3) "in" hyp(H) := destruct_relation_list' H x0 x1 x2 x3.
Tactic Notation "destruct_relation_list" ident(x0) ident(x1) ident(x2) ident(x3) ident(x4) "in" hyp(H) := destruct_relation_list' H x0 x1 x2 x3 x4.
Tactic Notation "destruct_relation_list" ident(x0) ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) "in" hyp(H) := destruct_relation_list' H x0 x1 x2 x3 x4 x5.
Tactic Notation "destruct_relation_list" ident(x0) ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6) "in" hyp(H) := destruct_relation_list' H x0 x1 x2 x3 x4 x5 x6.
Tactic Notation "destruct_relation_list" ident(x0) ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) "in" hyp(H) := destruct_relation_list' H x0 x1 x2 x3 x4 x5 x6 x7.
Tactic Notation "destruct_relation_list" ident(x0) ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ident(x8) "in" hyp(H) := destruct_relation_list' H x0 x1 x2 x3 x4 x5 x6 x7 x8.
Tactic Notation "destruct_relation_list" ident(x0) ident(x1) ident(x2) ident(x3) ident(x4) ident(x5) ident(x6) ident(x7) ident(x8) ident(x9) "in" hyp(H) := destruct_relation_list' H x0 x1 x2 x3 x4 x5 x6 x7 x8 x9.