(* (c) Copyright 2006-2016 Microsoft Corporation and Inria.                  *)
(* Distributed under the terms of CeCILL-B.                                  *)
From mathcomp
(******************************************************************************)
(* A theory of boolean predicates and operators. A large part of this file is *)
(* concerned with boolean reflection.                                         *)
(* Definitions and notations:                                                 *)
(*               is_true b == the coercion of b : bool to Prop (:= b = true). *)
(*                            This is just input and displayed as `b''.       *)
(*             reflect P b == the reflection inductive predicate, asserting   *)
(*                            that the logical proposition P : prop with the  *)
(*                            formula b : bool. Lemmas asserting reflect P b  *)
(*                            are often referred to as "views".               *)
(*  iffP, appP, sameP, rwP :: lemmas for direct manipulation of reflection    *)
(*                            views: iffP is used to prove reflection from    *)
(*                            logical equivalence, appP to compose views, and *)
(*                            sameP and rwP to perform boolean and setoid     *)
(*                            rewriting.                                      *)
(*                   elimT :: coercion reflect >-> Funclass, which allows the *)
(*                            direct application of `reflect' views to        *)
(*                            boolean assertions.                             *)
(*             decidable P <-> P is effectively decidable (:= {P} + {~ P}.    *)
(*    contra, contraL, ... :: contraposition lemmas.                          *)
(*           altP my_viewP :: natural alternative for reflection; given       *)
(*                            lemma myviewP: reflect my_Prop my_formula,      *)
(*                              have [myP | not_myP] := altP my_viewP.        *)
(*                            generates two subgoals, in which my_formula has *)
(*                            been replaced by true and false, resp., with    *)
(*                            new assumptions myP : my_Prop and               *)
(*                            not_myP: ~~ my_formula.                         *)
(*                            Caveat: my_formula must be an APPLICATION, not  *)
(*                            a variable, constant, let-in, etc. (due to the  *)
(*                            poor behaviour of dependent index matching).    *)
(*        boolP my_formula :: boolean disjunction, equivalent to              *)
(*                            altP (idP my_formula) but circumventing the     *)
(*                            dependent index capture issue; destructing      *)
(*                            boolP my_formula generates two subgoals with    *)
(*                            assumtions my_formula and ~~ myformula. As      *)
(*                            with altP, my_formula must be an application.   *)
(*            \unless C, P <-> we can assume property P when a something that *)
(*                            holds under condition C (such as C itself).     *)
(*                         := forall G : Prop, (C -> G) -> (P -> G) -> G.     *)
(*                            This is just C \/ P or rather its impredicative *)
(*                            encoding, whose usage better fits the above     *)
(*                            description: given a lemma UCP whose conclusion *)
(*                            is \unless C, P we can assume P by writing:     *)
(*                              wlog hP: / P by apply/UCP; (prove C -> goal). *)
(*                           or even apply: UCP id _ => hP if the goal is C.  *)
(*           classically P <-> we can assume P when proving is_true b.        *)
(*                         := forall b : bool, (P -> b) -> b.                 *)
(*                            This is equivalent to ~ (~ P) when P : Prop.    *)
(*             implies P Q == wrapper coinductive type that coerces to P -> Q *)
(*                            and can be used as a P -> Q view unambigously.  *)
(*                            Useful to avoid spurious insertion of <-> views *)
(*                            when Q is a conjunction of foralls, as in Lemma *)
(*                            all_and2 below; conversely, avoids confusion in *)
(*                            apply views for impredicative properties, such  *)
(*                            as \unless C, P. Also supports contrapositives. *)
(*                  a && b == the boolean conjunction of a and b.             *)
(*                  a || b == the boolean disjunction of a and b.             *)
(*                 a ==> b == the boolean implication of b by a.              *)
(*                    ~~ a == the boolean negation of a.                      *)
(*                 a (+) b == the boolean exclusive or (or sum) of a and b.   *)
(*     [ /\ P1 , P2 & P3 ] == multiway logical conjunction, up to 5 terms.    *)
(*     [ \/ P1 , P2 | P3 ] == multiway logical disjunction, up to 4 terms.    *)
(*        [&& a, b, c & d] == iterated, right associative boolean conjunction *)
(*                            with arbitrary arity.                           *)
(*        [|| a, b, c | d] == iterated, right associative boolean disjunction *)
(*                            with arbitrary arity.                           *)
(*      [==> a, b, c => d] == iterated, right associative boolean implication *)
(*                            with arbitrary arity.                           *)
(*              and3P, ... == specific reflection lemmas for iterated         *)
(*                            connectives.                                    *)
(*       andTb, orbAC, ... == systematic names for boolean connective         *)
(*                            properties (see suffix conventions below).      *)
(*              prop_congr == a tactic to move a boolean equality from        *)
(*                            its coerced form in Prop to the equality        *)
(*                            in bool.                                        *)
(*              bool_congr == resolution tactic for blindly weeding out       *)
(*                            like terms from boolean equalities (can fail).  *)
(* This file provides a theory of boolean predicates and relations:           *)
(*                  pred T == the type of bool predicates (:= T -> bool).     *)
(*            simpl_pred T == the type of simplifying bool predicates, using  *)
(*                            the simpl_fun from ssrfun.v.                    *)
(*                   rel T == the type of bool relations.                     *)
(*                         := T -> pred T or T -> T -> bool.                  *)
(*             simpl_rel T == type of simplifying relations.                  *)
(*                predType == the generic predicate interface, supported for  *)
(*                            for lists and sets.                             *)
(*              pred_class == a coercion class for the predType projection to *)
(*                            pred; declaring a coercion to pred_class is an  *)
(*                            alternative way of equipping a type with a      *)
(*                            predType structure, which interoperates better  *)
(*                            with coercion subtyping. This is used, e.g.,    *)
(*                            for finite sets, so that finite groups inherit  *)
(*                            the membership operation by coercing to sets.   *)
(* If P is a predicate the proposition "x satisfies P" can be written         *)
(* applicatively as (P x), or using an explicit connective as (x \in P); in   *)
(* the latter case we say that P is a "collective" predicate. We use A, B     *)
(* rather than P, Q for collective predicates:                                *)
(*                 x \in A == x satisfies the (collective) predicate A.       *)
(*              x \notin A == x doesn't satisfy the (collective) predicate A. *)
(* The pred T type can be used as a generic predicate type for either kind,   *)
(* but the two kinds of predicates should not be confused. When a "generic"   *)
(* pred T value of one type needs to be passed as the other the following     *)
(* conversions should be used explicitly:                                     *)
(*             SimplPred P == a (simplifying) applicative equivalent of P.    *)
(*                   mem A == an applicative equivalent of A:                 *)
(*                            mem A x simplifies to x \in A.                  *)
(* Alternatively one can use the syntax for explicit simplifying predicates   *)
(* and relations (in the following x is bound in E):                          *)
(*            [pred x | E] == simplifying (see ssrfun) predicate x => E.      *)
(*        [pred x : T | E] == predicate x => E, with a cast on the argument.  *)
(*          [pred : T | P] == constant predicate P on type T.                 *)
(*      [pred x | E1 & E2] == [pred x | E1 && E2]; an x : T cast is allowed.  *)
(*           [pred x in A] == [pred x | x in A].                              *)
(*       [pred x in A | E] == [pred x | x in A & E].                          *)
(* [pred x in A | E1 & E2] == [pred x in A | E1 && E2].                       *)
(*           [predU A & B] == union of two collective predicates A and B.     *)
(*           [predI A & B] == intersection of collective predicates A and B.  *)
(*           [predD A & B] == difference of collective predicates A and B.    *)
(*               [predC A] == complement of the collective predicate A.       *)
(*          [preim f of A] == preimage under f of the collective predicate A. *)
(*          predU P Q, ... == union, etc of applicative predicates.           *)
(*                   pred0 == the empty predicate.                            *)
(*                   predT == the total (always true) predicate.              *)
(*                            if T : predArgType, then T coerces to predT.    *)
(*                   {: T} == T cast to predArgType (e.g., {: bool * nat})    *)
(* In the following, x and y are bound in E:                                  *)
(*           [rel x y | E] == simplifying relation x, y => E.                 *)
(*       [rel x y : T | E] == simplifying relation with arguments cast.       *)
(*  [rel x y in A & B | E] == [rel x y | [&& x \in A, y \in B & E]].          *)
(*      [rel x y in A & B] == [rel x y | (x \in A) && (y \in B)].             *)
(*      [rel x y in A | E] == [rel x y in A & A | E].                         *)
(*          [rel x y in A] == [rel x y in A & A].                             *)
(*                relU R S == union of relations R and S.                     *)
(* Explicit values of type pred T (i.e., lamdba terms) should always be used  *)
(* applicatively, while values of collection types implementing the predType  *)
(* interface, such as sequences or sets should always be used as collective   *)
(* predicates. Defined constants and functions of type pred T or simpl_pred T *)
(* as well as the explicit simpl_pred T values described below, can generally *)
(* be used either way. Note however that x \in A will not auto-simplify when  *)
(* A is an explicit simpl_pred T value; the generic simplification rule inE   *)
(* must be used (when A : pred T, the unfold_in rule can be used). Constants  *)
(* of type pred T with an explicit simpl_pred value do not auto-simplify when *)
(* used applicatively, but can still be expanded with inE. This behavior can  *)
(* be controlled as follows:                                                  *)
(*   Let A : collective_pred T := [pred x | ... ].                            *)
(*     The collective_pred T type is just an alias for pred T, but this cast  *)
(*     stops rewrite inE from expanding the definition of A, thus treating A  *)
(*     into an abstract collection (unfold_in or in_collective can be used to *)
(*     expand manually).                                                      *)
(*   Let A : applicative_pred T := [pred x | ...].                            *)
(*     This cast causes inE to turn x \in A into the applicative A x form;    *)
(*     A will then have to unfolded explicitly with the /A rule. This will    *)
(*     also apply to any definition that reduces to A (e.g., Let B := A).     *)
(*   Canonical A_app_pred := ApplicativePred A.                               *)
(*     This declaration, given after definition of A, similarly causes inE to *)
(*     turn x \in A into A x, but in addition allows the app_predE rule to    *)
(*     turn A x back into x \in A; it can be used for any definition of type  *)
(*     pred T, which makes it especially useful for ambivalent predicates     *)
(*     as the relational transitive closure connect, that are used in both    *)
(*     applicative and collective styles.                                     *)
(* Purely for aesthetics, we provide a subtype of collective predicates:      *)
(*   qualifier q T == a pred T pretty-printing wrapper. An A : qualifier q T  *)
(*                    coerces to pred_class and thus behaves as a collective  *)
(*                    predicate, but x \in A and x \notin A are displayed as: *)
(*             x \is A and x \isn't A when q = 0,                             *)
(*         x \is a A and x \isn't a A when q = 1,                             *)
(*       x \is an A and x \isn't an A when q = 2, respectively.               *)
(*   [qualify x | P] := Qualifier 0 (fun x => P), constructor for the above.  *)
(* [qualify x : T | P], [qualify a x | P], [qualify an X | P], etc.           *)
(*                  variants of the above with type constraints and different *)
(*                  values of q.                                              *)
(* We provide an internal interface to support attaching properties (such as  *)
(* being multiplicative) to predicates:                                       *)
(*    pred_key p == phantom type that will serve as a support for properties  *)
(*                  to be attached to p : pred_class; instances should be     *)
(*                  created with Fact/Qed so as to be opaque.                 *)
(* KeyedPred k_p == an instance of the interface structure that attaches      *)
(*                  (k_p : pred_key P) to P; the structure projection is a    *)
(*                  coercion to pred_class.                                   *)
(* KeyedQualifier k_q == an instance of the interface structure that attaches *)
(*                  (k_q : pred_key q) to (q : qualifier n T).                *)
(* DefaultPredKey p == a default value for pred_key p; the vernacular command *)
(*                  Import DefaultKeying attaches this key to all predicates  *)
(*                  that are not explicitly keyed.                            *)
(* Keys can be used to attach properties to predicates, qualifiers and        *)
(* generic nouns in a way that allows them to be used transparently. The key  *)
(* projection of a predicate property structure such as unsignedPred should   *)
(* be a pred_key, not a pred, and corresponding lemmas will have the form     *)
(*    Lemma rpredN R S (oppS : @opprPred R S) (kS : keyed_pred oppS) :        *)
(*       {mono -%R: x / x \in kS}.                                            *)
(* Because x \in kS will be displayed as x \in S (or x \is S, etc), the       *)
(* canonical instance of opprPred will not normally be exposed (it will also  *)
(* be erased by /= simplification). In addition each predicate structure      *)
(* should have a DefaultPredKey Canonical instance that simply issues the     *)
(* property as a proof obligation (which can be caught by the Prop-irrelevant *)
(* feature of the ssreflect plugin).                                          *)
(*   Some properties of predicates and relations:                             *)
(*                  A =i B <-> A and B are extensionally equivalent.          *)
(*         {subset A <= B} <-> A is a (collective) subpredicate of B.         *)
(*             subpred P Q <-> P is an (applicative) subpredicate or Q.       *)
(*              subrel R S <-> R is a subrelation of S.                       *)
(* In the following R is in rel T:                                            *)
(*             reflexive R <-> R is reflexive.                                *)
(*           irreflexive R <-> R is irreflexive.                              *)
(*             symmetric R <-> R (in rel T) is symmetric (equation).          *)
(*         pre_symmetric R <-> R is symmetric (implication).                  *)
(*         antisymmetric R <-> R is antisymmetric.                            *)
(*                 total R <-> R is total.                                    *)
(*            transitive R <-> R is transitive.                               *)
(*       left_transitive R <-> R is a congruence on its left hand side.       *)
(*      right_transitive R <-> R is a congruence on its right hand side.      *)
(*       equivalence_rel R <-> R is an equivalence relation.                  *)
(* Localization of (Prop) predicates; if P1 is convertible to forall x, Qx,   *)
(* P2 to forall x y, Qxy and P3 to forall x y z, Qxyz :                       *)
(*            {for y, P1} <-> Qx{y / x}.                                      *)
(*             {in A, P1} <-> forall x, x \in A -> Qx.                        *)
(*       {in A1 & A2, P2} <-> forall x y, x \in A1 -> y \in A2 -> Qxy.        *)
(*           {in A &, P2} <-> forall x y, x \in A -> y \in A -> Qxy.          *)
(*  {in A1 & A2 & A3, Q3} <-> forall x y z,                                   *)
(*                            x \in A1 -> y \in A2 -> z \in A3 -> Qxyz.       *)
(*     {in A1 & A2 &, Q3} == {in A1 & A2 & A2, Q3}.                           *)
(*      {in A1 && A3, Q3} == {in A1 & A1 & A3, Q3}.                           *)
(*          {in A &&, Q3} == {in A & A & A, Q3}.                              *)
(*    {in A, bijective f} == f has a right inverse in A.                      *)
(*             {on C, P1} == forall x, (f x) \in C -> Qx                      *)
(*                           when P1 is also convertible to Pf f.             *)
(*           {on C &, P2} == forall x y, f x \in C -> f y \in C -> Qxy        *)
(*                           when P2 is also convertible to Pf f.             *)
(*        {on C, P1' & g} == forall x, (f x) \in cd -> Qx                     *)
(*                           when P1' is convertible to Pf f                  *)
(*                           and P1' g is convertible to forall x, Qx.        *)
(*    {on C, bijective f} == f has a right inverse on C.                      *)
(* This file extends the lemma name suffix conventions of ssrfun as follows:  *)
(*   A -- associativity, as in andbA : associative andb.                      *)
(*  AC -- right commutativity.                                                *)
(* ACA -- self-interchange (inner commutativity), e.g.,                       *)
(*        orbACA : (a || b) || (c || d) = (a || c) || (b || d).               *)
(*   b -- a boolean argument, as in andbb : idempotent andb.                  *)
(*   C -- commutativity, as in andbC : commutative andb,                      *)
(*        or predicate complement, as in predC.                               *)
(*  CA -- left commutativity.                                                 *)
(*   D -- predicate difference, as in predD.                                  *)
(*   E -- elimination, as in negbFE : ~~ b = false -> b.                      *)
(*   F or f -- boolean false, as in andbF : b && false = false.               *)
(*   I -- left/right injectivity, as in addbI : right_injective addb,         *)
(*        or predicate intersection, as in predI.                             *)
(*   l -- a left-hand operation, as andb_orl : left_distributive andb orb.    *)
(*   N or n -- boolean negation, as in andbN : a && (~~ a) = false.           *)
(*   P -- a characteristic property, often a reflection lemma, as in          *)
(*        andP : reflect (a /\ b) (a && b).                                   *)
(*   r -- a right-hand operation, as orb_andr : rightt_distributive orb andb. *)
(*   T or t -- boolean truth, as in andbT: right_id true andb.                *)
(*   U -- predicate union, as in predU.                                       *)
(*   W -- weakening, as in in1W : {in D, forall x, P} -> forall x, P.         *)
(******************************************************************************)
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Reserved Notation "~~ b" (at level 35, right associativity).
Reserved Notation "b ==> c" (at level 55, right associativity).
Reserved Notation "b1  (+)  b2" (at level 50, left associativity).
Reserved Notation "x \in A"
(at level 70, format "'[hv' x '/ '  \in  A ']'", no associativity).
Reserved Notation "x \notin A"
(at level 70, format "'[hv' x '/ '  \notin  A ']'", no associativity).
Reserved Notation "p1 =i p2"
(at level 70, format "'[hv' p1 '/ '  =i  p2 ']'", no associativity).
(* We introduce a number of n-ary "list-style" notations that share a common  *)
(* format, namely                                                             *)
(*    [op arg1, arg2, ... last_separator last_arg]                            *)
(* This usually denotes a right-associative applications of op, e.g.,         *)
(*  [&& a, b, c & d] denotes a && (b && (c && d))                             *)
(* The last_separator must be a non-operator token. Here we use &, | or =>;   *)
(* our default is &, but we try to match the intended meaning of op. The      *)
(* separator is a workaround for limitations of the parsing engine; the same  *)
(* limitations mean the separator cannot be omitted even when last_arg can.   *)
(*   The Notation declarations are complicated by the separate treatment for  *)
(* some fixed arities (binary for bool operators, and all arities for Prop    *)
(* operators).                                                                *)
(*   We also use the square brackets in comprehension-style notations         *)
(*    [type var separator expr]                                               *)
(* where "type" is the type of the comprehension (e.g., pred) and "separator" *)
(* is | or => . It is important that in other notations a leading square      *)
(* bracket [ is always followed by an operator symbol or a fixed identifier.  *)
Reserved Notation "[ /\ P1 & P2 ]" (at level 0, only parsing).
Reserved Notation "[ /\ P1 , P2 & P3 ]" (at level 0, format
"'[hv' [ /\ '['  P1 , '/'  P2 ']' '/ '  &  P3 ] ']'").
Reserved Notation "[ /\ P1 , P2 , P3 & P4 ]" (at level 0, format
"'[hv' [ /\ '['  P1 , '/'  P2 , '/'  P3 ']' '/ '  &  P4 ] ']'").
Reserved Notation "[ /\ P1 , P2 , P3 , P4 & P5 ]" (at level 0, format
"'[hv' [ /\ '['  P1 , '/'  P2 , '/'  P3 , '/'  P4 ']' '/ '  &  P5 ] ']'").
Reserved Notation "[ \/ P1 | P2 ]" (at level 0, only parsing).
Reserved Notation "[ \/ P1 , P2 | P3 ]" (at level 0, format
"'[hv' [ \/ '['  P1 , '/'  P2 ']' '/ '  |  P3 ] ']'").
Reserved Notation "[ \/ P1 , P2 , P3 | P4 ]" (at level 0, format
"'[hv' [ \/ '['  P1 , '/'  P2 , '/'  P3 ']' '/ '  |  P4 ] ']'").
Reserved Notation "[ && b1 & c ]" (at level 0, only parsing).
Reserved Notation "[ && b1 , b2 , .. , bn & c ]" (at level 0, format
"'[hv' [ && '['  b1 , '/'  b2 , '/'  .. , '/'  bn ']' '/ '  &  c ] ']'").
Reserved Notation "[ || b1 | c ]" (at level 0, only parsing).
Reserved Notation "[ || b1 , b2 , .. , bn | c ]" (at level 0, format
"'[hv' [ || '['  b1 , '/'  b2 , '/'  .. , '/'  bn ']' '/ '  |  c ] ']'").
Reserved Notation "[ ==> b1 => c ]" (at level 0, only parsing).
Reserved Notation "[ ==> b1 , b2 , .. , bn => c ]" (at level 0, format
"'[hv' [ ==> '['  b1 , '/'  b2 , '/'  .. , '/'  bn ']' '/'  =>  c ] ']'").
Reserved Notation "[ 'pred' : T => E ]" (at level 0, format
"'[hv' [ 'pred' :  T  => '/ '  E ] ']'").
Reserved Notation "[ 'pred' x => E ]" (at level 0, x at level 8, format
"'[hv' [ 'pred'  x  => '/ '  E ] ']'").
Reserved Notation "[ 'pred' x : T => E ]" (at level 0, x at level 8, format
"'[hv' [ 'pred'  x  :  T  => '/ '  E ] ']'").
Reserved Notation "[ 'rel' x y => E ]" (at level 0, x, y at level 8, format
"'[hv' [ 'rel'  x   y  => '/ '  E ] ']'").
Reserved Notation "[ 'rel' x y : T => E ]" (at level 0, x, y at level 8, format
"'[hv' [ 'rel'  x  y :  T  => '/ '  E ] ']'").
(* Shorter delimiter *)
Delimit Scope bool_scope with B.
Open Scope bool_scope.
(* An alternative to xorb that behaves somewhat better wrt simplification.    *)
Definition addb b := if b then negb else id.
(* Notation for && and || is declared in Init.Datatypes. *)
Notation "~~ b" := (negb b) : bool_scope.
Notation "b ==> c" := (implb b c) : bool_scope.
Notation "b1 (+) b2" := (addb b1 b2) : bool_scope.
(* Constant is_true b := b = true is defined in Init.Datatypes. *)
Coercion is_true : bool >-> Sortclass. (* Prop *)

Lemma classic_bind P Q : (P -> classically Q) -> classically P -> classically Q.