(**************************************************************************)
(* We follow ssrbool, and provide four different types of predicates.     *)
(*                                                                        *)
(* (1) Pred is the type of propositional functions                        *)
(* (2) Simpl_Pred is the type of predicates that automatically simplify   *)
(*     when used in an applicative position.                              *)
(* (3) Mem_Pred is for predicates that support infix notation x \In P     *) 
(* (4) PredType is the structure for interpreting various types, such as  *)
(* lists, tuples, etc. as predicates.                                     *)
(*                                                                        *)
(* Important point is that custom lemmas over predicates can be stated in *)
(* terms of Pred, while Simpl_Pred, Mem_Pred and PredType are for         *)
(* technical developments used in this file only. More on this point      *)
(* can be found in ssrbool.                                               *)
(**************************************************************************)

Definition Pred T := T -> Prop.Identity Coercion fun_of_Pred : Pred >-> Funclass.Notation xPred0 := (fun _ => False).Notation xPred1 := (fun x y => x = y).Notation xPredT := (fun _ => True).Notation xPredI := (fun (p1 p2 : Pred _) x => p1 x /\ p2 x).Notation xPredU := (fun (p1 p2 : Pred _) x => p1 x \/ p2 x).Notation xPredC := (fun (p : Pred _) x => ~ p x).Notation xPredD := (fun (p1 p2 : Pred _) x => ~ p2 x /\ p1 x).Notation xPreim := (fun f (p : Pred _) x => p (f x)).(* simple predicates *)

Definition Simpl_Pred := simpl_fun T Prop.Definition SimplPred (p : Pred T) : Simpl_Pred := SimplFun p.Coercion Pred_of_Simpl (p : Simpl_Pred) : Pred T := p : T -> Prop.(* it's useful to declare the operations as simple predicates, so that *)
(* complex expressions automatically reduce when used in applicative   *)
(* positions *)

Definition Pred0 := SimplPred xPred0.Definition Pred1 x := SimplPred (xPred1 x).Definition PredT := SimplPred xPredT.Definition PredI p1 p2 := SimplPred (xPredI p1 p2).Definition PredU p1 p2 := SimplPred (xPredU p1 p2).Definition PredC p := SimplPred (xPredC p).Definition PredD p1 p2 := SimplPred (xPredD p1 p2).Definition Preim rT f (d : Pred rT) := SimplPred (xPreim f d).(* membership predicates *)

CoInductive Mem_Pred : Type := MemProp of Pred T.(* membership predicates *)

CoInductive Mem_Pred : Type := MemProp of Pred T.Definition isMem pT toPred mem := mem = (fun p : pT => MemProp [eta toPred p]).(* the general structure for predicates *)

Structure PredType : Type := PropPredType {
  Pred_Sort :> Type; 
  toPred : Pred_Sort -> Pred T; 
  _ : {mem | isMem toPred mem}}.(* the general structure for predicates *)

Structure PredType : Type := PropPredType {
  Pred_Sort :> Type; 
  toPred : Pred_Sort -> Pred T; 
  _ : {mem | isMem toPred mem}}.(* the general structure for predicates *)

Structure PredType : Type := PropPredType {
  Pred_Sort :> Type; 
  toPred : Pred_Sort -> Pred T; 
  _ : {mem | isMem toPred mem}}.(* the general structure for predicates *)

Structure PredType : Type := PropPredType {
  Pred_Sort :> Type; 
  toPred : Pred_Sort -> Pred T; 
  _ : {mem | isMem toPred mem}}.Definition mkPredType pT toP :=
  PropPredType (exist (@isMem pT toP) _ (erefl _)).(* Pred, SimplPred, Mem_Pred, pred and simpl_pred are PredType's *)
Canonical Structure PredPredType := Eval hnf in @mkPredType (Pred T) id.Canonical Structure SimplPredPredType := Eval hnf in mkPredType Pred_of_Simpl.Coercion Pred_of_Mem mp : Pred_Sort PredPredType :=
  let: MemProp p := mp in [eta p].Canonical Structure MemPredType := Eval hnf in mkPredType Pred_of_Mem.Canonical Structure predPredType := Eval hnf in @mkPredType (pred T) id.Canonical Structure simplpredPredType := 
  Eval hnf in @mkPredType (simpl_pred T) (fun p x => p x).Notation "r1 +p r2" := (PredU r1 r2 : Pred _) 
  (at level 55, right associativity) : rel_scope.Notation "r1 *p r2" := (xPredI r1 r2 : Pred _) 
  (at level 45, right associativity) : rel_scope.Notation "[ 'Pred' : T | E ]" := (SimplPred (fun _ : T => E))
  (at level 0, format "[ 'Pred' :  T  |  E ]") : fun_scope.Notation "[ 'Pred' x | E ]" := (SimplPred (fun x => E))
  (at level 0, x ident, format "[ 'Pred'  x  |  E ]") : fun_scope.Notation "[ 'Pred' x : T | E ]" := (SimplPred (fun x : T => E))
  (at level 0, x ident, only parsing) : fun_scope.Notation "[ 'Pred' x y | E ]" := (SimplPred (fun t => let: (x, y) := t in E))
  (at level 0, x ident, y ident, format "[ 'Pred'  x  y  |  E ]") : fun_scope.Notation "[ 'Pred' x y : T | E ]" := 
  (SimplPred (fun t : (T*T) => let: (x, y) := t in E))
  (at level 0, x ident, y ident, only parsing) : fun_scope.Definition repack_Pred T pT :=
  let: PropPredType _ a mP := pT return {type of @PropPredType T for pT} -> _ in
   fun k => k a mP.Notation "[ 'PredType' 'of' T ]" := (repack_Pred (fun a => @PropPredType _ T a))
  (at level 0, format "[ 'PredType'  'of'  T ]") : form_scope.Notation Pred_Class := (Pred_Sort (PredPredType _)).Coercion Sort_of_Simpl_Pred T (p : Simpl_Pred T) : Pred_Class := p : Pred T.Definition PredArgType := Type.Coercion Pred_of_argType (T : PredArgType) : Simpl_Pred T := PredT.Notation "{ :: T }" := (T%type : PredArgType)
  (at level 0, format "{ ::  T }") : type_scope.(* These must be defined outside a Section because "cooking" kills the *)
(* nosimpl tag. *)
Definition Mem T (pT : PredType T) : pT -> Mem_Pred T :=
  nosimpl (let: PropPredType _ _ (exist mem _) := pT return pT -> _ in mem).Definition InMem T x mp := nosimpl Pred_of_Mem T mp x.(* Membership Predicates can be used as simple ones *)
Coercion Pred_of_Mem_Pred T mp := [Pred x : T | InMem x mp].(* equality and subset *)

Definition EqPredType T (pT : PredType T) (p1 p2 : pT) := 
  forall x : T, toPred p1 x <-> toPred p2 x.Definition SubPredType T (pT : PredType T) (p1 p2 : pT) := 
  forall x : T, toPred p1 x -> toPred p2 x.Definition EqSimplPred T (p1 p2 : Simpl_Pred T) := EqPredType p1 p2.Definition SubSimplPred T (p1 p2 : Simpl_Pred T) := SubPredType p1 p2.Definition EqPredFun T1 T2 (pT2 : PredType T2) p1 p2 := 
  forall x : T1, @EqPredType T2 pT2 (p1 x) (p2 x).Definition SubPredFun T1 T2 (pT2 : PredType T2) p1 p2 := 
  forall x : T1, @SubPredType T2 pT2 (p1 x) (p2 x).Definition EqMem T p1 p2 := forall x : T, InMem x p1 <-> InMem x p2.Definition SubMem T p1 p2 := forall x : T, InMem x p1 -> InMem x p2.Notation "A <~> B" := (@EqPredType _ _ A B) 
  (at level 70, no associativity) : rel_scope.Notation "A ~> B" := (@SubPredType _ _ A B) 
  (at level 70, no associativity) : rel_scope.Notation "A <~1> B" := (@EqPredFun _ _ _ A B) 
  (at level 70, no associativity) : rel_scope.Notation "A ~1> B" := (@SubPredFun _ _ _ A B) 
  (at level 70, no associativity) : rel_scope.Notation "x \In A" := (InMem x (Mem A)) 
  (at level 70, no associativity) : rel_scope.Notation "x \Notin A" := (~ (x \In A)) 
  (at level 70, no associativity) : rel_scope.Notation "A =p B" := (EqMem (Mem A) (Mem B)) 
  (at level 70, no associativity) : type_scope.Notation "A <=p B" := (SubMem (Mem A) (Mem B))  
  (at level 70, no associativity) : type_scope.(* Some notation for turning PredTypes into Pred or Simple Pred *)
Notation "[ 'Mem' A ]" := (Pred_of_Simpl (Pred_of_Mem_Pred (Mem A)))
  (at level 0, only parsing) : fun_scope.Notation "[ 'PredI' A & B ]" := (PredI [Mem A] [Mem B])
  (at level 0, format "[ 'PredI'  A  &  B ]") : fun_scope.Notation "[ 'PredU' A & B ]" := (PredU [Mem A] [Mem B])
  (at level 0, format "[ 'PredU'  A  &  B ]") : fun_scope.Notation "[ 'PredD' A & B ]" := (PredD [Mem A] [Mem B])
  (at level 0, format "[ 'PredD'  A  &  B ]") : fun_scope.Notation "[ 'PredC' A ]" := (PredC [Mem A])
  (at level 0, format "[ 'PredC'  A ]") : fun_scope.Notation "[ 'Preim' f 'of' A ]" := (Preim f [Mem A])
  (at level 0, format "[ 'Preim'  f  'of'  A ]") : fun_scope.Notation "[ 'Pred' x \In A ]" := [Pred x | x \In A]
  (at level 0, x ident, format "[ 'Pred'  x  \In  A ]") : fun_scope.Notation "[ 'Pred' x \In A | E ]" := [Pred x | (x \In A) /\ E]
  (at level 0, x ident, format "[ 'Pred'  x  \In  A  |  E ]") : fun_scope.Notation "[ 'Pred' x y \In A & B | E ]" :=
  [Pred x y | (x \In A) /\ (y \In B) /\ E]
  (at level 0, x ident, y ident,
   format "[ 'Pred'  x  y  \In  A  &  B  |  E ]") : fun_scope.Notation "[ 'Pred' x y \In A & B ]" := [Pred x y | (x \In A) /\ (y \In B)]
  (at level 0, x ident, y ident,
   format "[ 'Pred'  x  y  \In  A  &  B ]") : fun_scope.Notation "[ 'Pred' x y \In A | E ]" := [Pred x y \In A & A | E]
  (at level 0, x ident, y ident,
   format "[ 'Pred'  x  y  \In  A  |  E ]") : fun_scope.Notation "[ 'Pred' x y \In A ]" := [Pred x y \In A & A]
  (at level 0, x ident, y ident,
   format "[ 'Pred'  x  y  \In  A ]") : fun_scope.

Lemma Mem_toPred : forall (p : pT), Mem (toPred p) = Mem p.