(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
(* Distributed under the terms of CeCILL-B.                                  *)
(* -*- coding : utf-8 -*- *)
From mathcomp
(*****************************************************************************)
(* Provided a base type T, this files defines an interface for quotients Q   *)
(* of the type T with explicit functions for canonical surjection (\pi       *)
(* : T -> Q) and for choosing a representative (repr : Q -> T).  It then     *)
(* provide a helper to quotient T by a decidable equivalence relation (e     *)
(* : rel T) if T is a choiceType (or encodable as a choiceType modulo e).    *)
(*                                                                           *)
(* See "Pragamatic Quotient Types in Coq", proceedings of ITP2013,           *)
(* by Cyril Cohen.                                                           *)
(*                                                                           *)
(* *** Generic Quotienting ***                                               *)
(*   QuotClass (reprK : cancel repr pi) == builds the quotient which         *)
(*              canonical surjection function is pi and which                *)
(*              representative selection function is repr.                   *)
(*   QuotType Q class == packs the quotClass class to build a quotType       *)
(*                       You may declare such elements as Canonical          *)
(*            \pi_Q x == the class in Q of the element x of T                *)
(*              \pi x == the class of x where Q is inferred from the context *)
(*             repr c == canonical representative in T of the class c        *)
(*    [quotType of Q] == clone of the canonical quotType structure of Q on T *)
(*     x = y %[mod Q] := \pi_Q x = \pi_Q y                                   *)
(*                    <-> x and y are equal modulo Q                         *)
(*    x <> y %[mod Q] := \pi_Q x <> \pi_Q y                                  *)
(*    x == y %[mod Q] := \pi_Q x == \pi_Q y                                  *)
(*    x != y %[mod Q] := \pi_Q x != \pi_Q y                                  *)
(*                                                                           *)
(* The quotient_scope is delimited by %qT                                    *)
(* The most useful lemmas are piE and reprK                                  *)
(*                                                                           *)
(* *** Morphisms ***                                                         *)
(* One may declare existing functions and predicates as liftings of some     *)
(* morphisms for a quotient.                                                 *)
(*    PiMorph1 pi_f == where pi_f : {morph \pi : x / f x >-> fq x}           *)
(*                     declares fq : Q -> Q as the lifting of f : T -> T     *)
(*    PiMorph2 pi_g == idem with pi_g : {morph \pi : x y / g x y >-> gq x y} *)
(*     PiMono1 pi_p == idem with pi_p : {mono \pi : x / p x >-> pq x}        *)
(*     PiMono2 pi_r == idem with pi_r : {morph \pi : x y / r x y >-> rq x y} *)
(*   PiMorph11 pi_f == idem with pi_f : {morph \pi : x / f x >-> fq x}       *)
(*                     where fq : Q -> Q' and f : T -> T'.                   *)
(*       PiMorph eq == Most general declaration of compatibility,            *)
(*                     /!\ use with caution /!\                              *)
(* One can use the following helpers to build the liftings which may or      *)
(* may not satisfy the above properties (but if they do not, it is           *)
(* probably not a good idea to define them):                                 *)
(*       lift_op1 Q f := lifts f : T -> T                                    *)
(*       lift_op2 Q g := lifts g : T -> T -> T                               *)
(*      lift_fun1 Q p := lifts p : T -> R                                    *)
(*      lift_fun2 Q r := lifts r : T -> T -> R                               *)
(*   lift_op11 Q Q' f := lifts f : T -> T'                                   *)
(* There is also the special case of constants and embedding functions       *)
(* that one may define and declare as compatible with Q using:               *)
(*    lift_cst Q x := lifts x : T to Q                                       *)
(*       PiConst c := declare the result c of the previous construction as   *)
(*                    compatible with Q                                      *)
(*  lift_embed Q e := lifts e : R -> T to R -> Q                             *)
(*       PiEmbed f := declare the result f of the previous construction as   *)
(*                    compatible with Q                                      *)
(*                                                                           *)
(* *** Quotients that have an eqType structure ***                           *)
(* Having a canonical (eqQuotType e) structure enables piE to replace terms  *)
(* of the form (x == y) by terms of the form (e x' y') if x and y are        *)
(* canonical surjections of some x' and y'.                                  *)
(*    EqQuotType e Q m == builds an (eqQuotType e) structure on Q from the   *)
(*                        morphism property m                                *)
(*                        where m : {mono \pi : x y / e x y >-> x == y}      *)
(*   [eqQuotType of Q] == clones the canonical eqQuotType structure of Q     *)
(*                                                                           *)
(* *** Equivalence and quotient by an equivalence ***                        *)
(*  EquivRel r er es et == builds an equiv_rel structure based on the        *)
(*                         reflexivity, symmetry and transitivity property   *)
(*                         of a boolean relation.                            *)
(*          {eq_quot e} == builds the quotType of T by equiv                 *)
(*                         where e : rel T is an equiv_rel                   *)
(*                         and T is a choiceType or a (choiceTypeMod e)      *)
(*                         it is canonically an eqType, a choiceType,        *)
(*                         a quotType and an eqQuotType.                     *)
(*    x = y %[mod_eq e] := x = y %[mod {eq_quot e}]                          *)
(*                      <-> x and y are equal modulo e                       *)
(*    ...                                                                    *)
(*****************************************************************************)
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Reserved Notation "\pi_ Q" (at level 0, format "\pi_ Q").
Reserved Notation "\pi" (at level 0, format "\pi").
Reserved Notation "{pi_ Q a }"
(at level 0, Q at next level, format "{pi_ Q  a }").
Reserved Notation "{pi a }" (at level 0, format "{pi  a }").
Reserved Notation "x == y %[mod_eq e ]" (at level 70, y at next level,
no associativity,   format "'[hv ' x '/'  ==  y '/'  %[mod_eq  e ] ']'").
Reserved Notation "x = y %[mod_eq e ]" (at level 70, y at next level,
no associativity,   format "'[hv ' x '/'  =  y '/'  %[mod_eq  e ] ']'").
Reserved Notation "x != y %[mod_eq e ]" (at level 70, y at next level,
no associativity,   format "'[hv ' x '/'  !=  y '/'  %[mod_eq  e ] ']'").
Reserved Notation "x <> y %[mod_eq e ]" (at level 70, y at next level,
no associativity,   format "'[hv ' x '/'  <>  y '/'  %[mod_eq  e ] ']'").
Reserved Notation "{eq_quot e }" (at level 0, e at level 0,
format "{eq_quot  e }", only parsing).
Delimit Scope quotient_scope with qT.
Local Open Scope quotient_scope.
(*****************************************)
(* Definition of the quotient interface. *)
(*****************************************)
Section QuotientDef.
Variable T : Type.
Record quot_mixin_of qT := QuotClass {
quot_repr : qT -> T;
quot_pi : T -> qT;
_ : cancel quot_repr quot_pi
}.
Notation quot_class_of := quot_mixin_of.
Record quotType := QuotTypePack {
quot_sort :> Type;
quot_class : quot_class_of quot_sort
}.
Variable qT : quotType.
Definition pi_phant of phant qT := quot_pi (quot_class qT).
Local Notation "\pi" := (pi_phant (Phant qT)).
Definition repr_of := quot_repr (quot_class qT).

(* Specifications: *)
Lemma repr_ofK : cancel repr_of \pi.
Definition enc_mod_rel_equiv_rel := EquivRelPack enc_mod_rel_is_equiv.