Require Export PnV.Prelude.SfLib.
Require Export PnV.Prelude.Notations.
Require Export Coq.Arith.Compare_dec.
Require Export Coq.Arith.PeanoNat.
Require Export Coq.Bool.Bool.
Require Export Coq.Classes.RelationClasses.
Require Export Coq.Lists.List.
Require Export Coq.micromega.Lia.
Require Export Coq.Program.Basics.
Require Export Coq.Program.Utils.
Require Export Coq.Relations.Relation_Definitions.
Require Export Coq.Relations.Relation_Operators.
Require Export Coq.Setoids.Setoid.
Create HintDb simplication_hints.
#[global] Hint Rewrite forallb_app orb_true_iff orb_false_iff andb_true_iff andb_false_iff negb_true_iff negb_false_iff Nat.eqb_eq Nat.eqb_neq not_true_iff_false not_false_iff_true : simplication_hints.
Ltac obs_eqb n m :=
let H_OBS := fresh "H_OBS" in destruct (Nat.eqb n m) as [ | ] eqn: H_OBS; [rewrite Nat.eqb_eq in H_OBS | rewrite Nat.eqb_neq in H_OBS].
#[local] Obligation Tactic := idtac.
Ltac property X :=
eapply (proj2_sig X).
Tactic Notation "rewrite!" :=
autorewrite with simplication_hints in *.
#[universes(polymorphic=yes)]
Definition reify@{u v} {A : Type@{u}} {B : Type@{v}} {P : A -> B -> Prop} (f : forall x : A, { y : B | P x y }) : { f : A -> B | forall x, P x (f x) } :=
@exist (A -> B) (fun f => forall x, P x (f x)) (fun x => proj1_sig (f x)) (fun x => proj2_sig (f x)).
#[universes(polymorphic=yes)]
Definition reify_lemma@{u v} {A : Type@{u}} {B : Type@{u}} {P : A -> B -> Prop} (f : forall x : A, { y : B | P x y }) : forall x, P x (proj1_sig (@reify@{u v} A B P f) x) :=
proj2_sig (@reify@{u v} A B P f).
(** Section SETOID. *)
Class isSetoid (A : Type) : Type :=
{ eqProp (lhs : A) (rhs : A) : Prop
; eqProp_Equivalence :: Equivalence eqProp
}.
Infix "==" := eqProp : type_scope.
#[global, program]
Instance Prop_isSetoid : isSetoid Prop :=
{ eqProp := iff
; eqProp_Equivalence := iff_equivalence
}.
#[global, program]
Instance pi_isSetoid {A : Type} {B : A -> Type} `(SETOID : forall x : A, isSetoid (B x)) : isSetoid (forall x : A, B x) :=
{ eqProp f g := forall x, f x == g x }.
Next Obligation.
split.
- intros f1 x. reflexivity.
- intros f1 f2 EQ x. symmetry; exact (EQ x).
- intros f1 f2 f3 EQ EQ' x. transitivity (f2 x); [exact (EQ x) | exact (EQ' x)].
Qed.
#[program]
Definition mkSetoidFromPreOrder {A : Type} {leProp : A -> A -> Prop} `(leProp_PreOrder : @PreOrder A leProp) : isSetoid A :=
{| eqProp (x : A) (y : A) := leProp x y /\ leProp y x |}.
Next Obligation.
split; ii.
- exact (conj (@PreOrder_Reflexive A leProp leProp_PreOrder x) (@PreOrder_Reflexive A leProp leProp_PreOrder x)).
- exact (conj (proj2 H) (proj1 H)).
- exact (conj (@PreOrder_Transitive A leProp leProp_PreOrder x y z (proj1 H) (proj1 H0)) (@PreOrder_Transitive A leProp leProp_PreOrder z y x (proj2 H0) (proj2 H))).
Defined.

Lemma mkSetoidFromPreOrder_good {A : Type} {leProp : A -> A -> Prop} `(leProp_PreOrder : @PreOrder A leProp)
(SETOID := mkSetoidFromPreOrder leProp_PreOrder)
: PartialOrder SETOID.(eqProp) leProp.