Require Import ZArith.

Open Scope Z_scope.

Record Hurwitz : Set := mkHurwitz { h : Z ; i : Z ; j : Z ; k : Z }.

(** Internal operations *)

Definition hopp (h1 : Hurwitz) : Hurwitz :=
  let (h1, i1, j1, k1) := h1 in
  mkHurwitz (- h1) (- i1) (- j1) (- k1).

Definition hadd (h1 h2 : Hurwitz) : Hurwitz :=
  let (h1, i1, j1, k1) := h1 in
  let (h2, i2, j2, k2) := h2 in
  mkHurwitz (h1 + h2) (i1 + i2) (j1 + j2) (k1 + k2).

Definition hminus (h1 h2 : Hurwitz) : Hurwitz := hadd h1 (hopp h2).

Definition hmul (h1 h2 : Hurwitz) : Hurwitz :=
  let (h1, i1, j1, k1) := h1 in
  let (h2, i2, j2, k2) := h2 in
  let hh := h1 * h2 in
  let hi := h1 * i2 in
  let hj := h1 * j2 in
  let hk := h1 * k2 in
  let ih := i1 * h2 in
  let ii := i1 * i2 in
  let ij := i1 * j2 in
  let ik := i1 * k2 in
  let jh := j1 * h2 in
  let ji := j1 * i2 in
  let jj := j1 * j2 in
  let jk := j1 * k2 in
  let kh := k1 * h2 in
  let ki := k1 * i2 in
  let kj := k1 * j2 in
  let kk := k1 * k2 in
    mkHurwitz
      (- hh - hi - hj - hk - ih - 2 * ii - jh - 2 * jj - kh - 2 * kk)
      (hh + hi + hk + ih + ii + jh + jj + jk - kj + kk)
      (hh + hi + hj + ii - ik + jh + jj + kh + ki + kk)
      (hh + hj + hk + ih + ii + ij - ji + jj + kh + kk).

(* awesome bash:
 for x in h i j k; do for y in h i j k; do
 echo "let $x$y := ${x}1 * ${y}2 in"; done; done *)

(** Notations *)

Notation "h-" := hopp.
Infix " h+ " := hadd (at level 50).
Infix " h- " := hminus (at level 10).
Infix " h* " := hmul (at level 60).

(** External operations *)

Definition IZH (n : Z) : Hurwitz := mkHurwitz (2 * n) (- n) (- n) (- n).

Definition hsmul (k : Z) (h1 : Hurwitz) : Hurwitz :=
  let (h1, i1, j1, k1) := h1 in
  mkHurwitz (k * h1) (k * i1) (k * j1) (k * k1).

(** Conjugate, norm *)

Definition hconj (h : Hurwitz) :=
  let (a, b, c, d) := h in
  mkHurwitz a (- a - b) (- a - c) (- a - d).

Definition hnorm2 (h1 : Hurwitz) := (- i (hmul h1 (hconj h1)))%Z.

Definition is_real (x : Hurwitz) : Prop :=
  h x + 2 * i x = 0 /\ i x = j x /\ i x = k x.

(** Divisibility, units *)

Definition h1 := mkHurwitz 2 (- 1) (- 1) (- 1).
Definition hh := mkHurwitz 1 0 0 0.
Definition hi := mkHurwitz 0 1 0 0.
Definition hj := mkHurwitz 0 0 1 0.
Definition hk := mkHurwitz 0 0 0 1.

Definition divide (x y : Hurwitz) := { d | hmul x d = y }.

Definition is_H_unit (x : Hurwitz) := { y | hmul x y = IZH 1 }.

Inductive Z_unit := Z_one | Z_mone.

Definition halfsub (u v : Z_unit) : Z :=
  match u, v with
  | Z_one, Z_one => 0
  | Z_one, Z_mone => 1
  | Z_mone, Z_one => -1
  | Z_mone, Z_mone => 0
  end.

Definition Z_of_Z_unit (u : Z_unit) :=
  match u with
  | Z_one => 1
  | Z_mone => -1
  end.

Inductive H_unit : Hurwitz -> Type :=
  | H_unit_1 : forall u, let n := Z_of_Z_unit u in H_unit (mkHurwitz (2 * n) (- n) (- n) (- n))
  | H_unit_i : forall u, H_unit (mkHurwitz 0 (Z_of_Z_unit u) 0 0)
  | H_unit_j : forall u, H_unit (mkHurwitz 0 0 (Z_of_Z_unit u) 0)
  | H_unit_k : forall u, H_unit (mkHurwitz 0 0 0 (Z_of_Z_unit u))
  | H_unit_h : forall u v w z, H_unit (mkHurwitz
      (Z_of_Z_unit u)
      (halfsub v u)
      (halfsub w u)
      (halfsub z u)).


From Hammer Require Import Hammer.

From Topology Require Export TopologicalSpaces.
From Topology Require Export DirectedSets.
From Topology Require Export InteriorsClosures.
From Topology Require Export Continuity.

Set Asymmetric Patterns.

Section Net.

Variable I:DirectedSet.
Variable X:TopologicalSpace.

Definition Net := DS_set I -> point_set X.

Definition net_limit (x:Net) (x0:point_set X) : Prop :=
forall U:Ensemble (point_set X), open U -> In U x0 ->
for large i:DS_set I, In U (x i).

Definition net_cluster_point (x:Net) (x0:point_set X) : Prop :=
forall U:Ensemble (point_set X), open U -> In U x0 ->
exists arbitrarily large i:DS_set I, In U (x i).

Lemma net_limit_is_cluster_point: forall (x:Net) (x0:point_set X),
net_limit x x0 -> net_cluster_point x x0.
Proof. hammer_hook "Nets" "Nets.net_limit_is_cluster_point".
intros.
red; intros.
red; intros.
pose proof (H U H0 H1).
destruct H2.
destruct (DS_join_cond i x1).
destruct H3.
exists x2; split; trivial.
apply H2; trivial.
Qed.

Lemma net_limit_in_closure: forall (S:Ensemble (point_set X))
(x:Net) (x0:point_set X),
(exists arbitrarily large i:DS_set I, In S (x i)) ->
net_limit x x0 -> In (closure S) x0.
Proof. hammer_hook "Nets" "Nets.net_limit_in_closure".
intros.
apply NNPP.
red; intro.
pose proof (H0 (Complement (closure S))).
match type of H2 with | ?A -> ?B -> ?C => assert (C) end.
apply H2.
apply closure_closed.
assumption.
destruct H3.
pose proof (H x1).
destruct H4.
contradiction (H3 x2).
tauto.
apply closure_inflationary; tauto.
Qed.

Lemma net_cluster_point_in_closure: forall (S:Ensemble (point_set X))
(x:Net) (x0:point_set X),
(for large i:DS_set I, In S (x i)) ->
net_cluster_point x x0 -> In (closure S) x0.
Proof. hammer_hook "Nets" "Nets.net_cluster_point_in_closure".
intros.
apply NNPP.
red; intro.
pose proof (H0 (Complement (closure S))).
match type of H2 with | ?A -> ?B -> ?C => assert (C) end.
apply H2.
apply closure_closed.
assumption.
destruct H.
destruct (H3 x1).
destruct H4.
contradiction H5.
apply closure_inflationary.
apply H; trivial.
Qed.

End Net.

Arguments net_limit {I} {X}.
Arguments net_cluster_point {I} {X}.
Arguments net_limit_is_cluster_point {I} {X}.
Arguments net_limit_in_closure {I} {X}.
Arguments net_cluster_point_in_closure {I} {X}.

Section neighborhood_net.

Variable X:TopologicalSpace.
Variable x:point_set X.

Inductive neighborhood_net_DS_set : Type :=
| intro_neighborhood_net_DS :
forall (U:Ensemble (point_set X)) (y:point_set X),
open U -> In U x -> In U y -> neighborhood_net_DS_set.

Definition neighborhood_net_DS_ord
(Uy Vz:neighborhood_net_DS_set) : Prop :=
match Uy, Vz with
| intro_neighborhood_net_DS U _ _ _ _,
intro_neighborhood_net_DS V _ _ _ _ =>
Included V U
end.

Definition neighborhood_net_DS : DirectedSet.
refine (Build_DirectedSet neighborhood_net_DS_set
neighborhood_net_DS_ord _ _).
constructor.
red; intros.
destruct x0.
simpl; auto with sets.
red; intros.
destruct x0; destruct y; destruct z.
simpl in H; simpl in H0; simpl.
auto with sets.

intros.
destruct i; destruct j.
assert (open (Intersection U U0)).
apply open_intersection2; trivial.
assert (In (Intersection U U0) x); auto with sets.

exists (intro_neighborhood_net_DS (Intersection U U0) x
H H0 H0).
simpl; auto with sets.
Defined.

Definition neighborhood_net : Net neighborhood_net_DS X :=
fun (x:neighborhood_net_DS_set) => match x with
| intro_neighborhood_net_DS _ y _ _ _ => y
end.

Lemma neighborhood_net_limit: net_limit neighborhood_net x.
Proof. hammer_hook "Nets" "Nets.neighborhood_net_limit".
red; intros.
exists (intro_neighborhood_net_DS U x H H0 H0).
intros.
destruct j.
simpl in H1.
simpl.
auto with sets.
Qed.

End neighborhood_net.

Lemma net_limits_determine_topology:
forall {X:TopologicalSpace} (S:Ensemble (point_set X))
(x0:point_set X), In (closure S) x0 ->
exists I:DirectedSet, exists x:Net I X,
(forall i:DS_set I, In S (x i)) /\ net_limit x x0.
Proof. hammer_hook "Nets" "Nets.net_limits_determine_topology".
intros.
assert (forall U:Ensemble (point_set X), open U -> In U x0 ->
Inhabited (Intersection S U)).
intros.
apply NNPP; red; intro.
assert (Included (closure S) (Complement U)).
apply closure_minimal.
red; rewrite Complement_Complement; assumption.
red; intros.
red; red; red; intros.
contradiction H2.
exists x; auto with sets.
contradict H1.
apply H3.
assumption.
pose (Ssel := fun n:neighborhood_net_DS_set X x0 =>
match n with
| intro_neighborhood_net_DS V y _ _ _ => (In S y)
end).
pose (our_DS_set := {n:neighborhood_net_DS_set X x0 | Ssel n}).
pose (our_DS_ord := fun (n1 n2:our_DS_set) =>
neighborhood_net_DS_ord X x0 (proj1_sig n1) (proj1_sig n2)).
assert (preorder our_DS_ord).
constructor; red.
intros; red.
apply preord_refl.
apply (@DS_ord_cond (neighborhood_net_DS X x0)).
intros x y z.
unfold our_DS_ord; apply preord_trans.
apply (@DS_ord_cond (neighborhood_net_DS X x0)).
assert (forall i j:our_DS_set, exists k:our_DS_set,
our_DS_ord i k /\ our_DS_ord j k).
destruct i.
destruct x.
destruct j.
destruct x.
assert (open (Intersection U U0)).
apply open_intersection2; trivial.
assert (In (Intersection U U0) x0).
auto with sets.
assert (Inhabited (Intersection S (Intersection U U0))).
apply H0; trivial.
destruct H4.
destruct H4.
pose (k0 := intro_neighborhood_net_DS X x0
(Intersection U U0) x H2 H3 H5).
assert (Ssel k0).
red; unfold k0; simpl.
assumption.
exists (exist _ k0 H6).
split; red; simpl; auto with sets.

pose (our_DS := Build_DirectedSet our_DS_set our_DS_ord H1 H2).
exists our_DS.
exists (fun i:our_DS_set => neighborhood_net X x0 (proj1_sig i)).
split.
intros.
destruct i.
destruct x.
simpl.
simpl in s.
assumption.

red; intros.
assert (Inhabited (Intersection S U)).
apply H0; trivial.
destruct H5.
destruct H5.
pose (i0 := intro_neighborhood_net_DS X x0
U x H3 H4 H6).
assert (Ssel i0).
simpl; assumption.
exists (exist _ i0 H7).
intros.
destruct j.
destruct x1.
simpl in H8.
red in H8; simpl in H8.
simpl.
auto with sets.
Qed.

Section Nets_and_continuity.

Variable X Y:TopologicalSpace.
Variable f:point_set X -> point_set Y.

Lemma continuous_func_preserves_net_limits:
forall {I:DirectedSet} (x:Net I X) (x0:point_set X),
net_limit x x0 -> continuous_at f x0 ->
net_limit (fun i:DS_set I => f (x i)) (f x0).
Proof. hammer_hook "Nets" "Nets.continuous_func_preserves_net_limits".
intros.
red; intros V ? ?.
assert (neighborhood V (f x0)).
apply open_neighborhood_is_neighborhood; split; trivial.
pose proof (H0 V H3).
destruct H4 as [U [? ?]].
destruct H4.
pose proof (H U H4 H6).
apply eventually_impl_base with (fun i:DS_set I => In U (x i));
trivial.
intros.
assert (In (inverse_image f V) (x i)); auto with sets.
destruct H9; trivial.
Qed.

Lemma func_preserving_net_limits_is_continuous:
forall x0:point_set X,
(forall (I:DirectedSet) (x:Net I X),
net_limit x x0 -> net_limit (fun i:DS_set I => f (x i)) (f x0))
-> continuous_at f x0.
Proof. hammer_hook "Nets" "Nets.func_preserving_net_limits_is_continuous".
intros.
pose proof (H (neighborhood_net_DS X x0)
(neighborhood_net X x0)
(neighborhood_net_limit X x0)).
apply continuous_at_open_neighborhoods; intros.
destruct H1.
pose proof (H0 V H1 H2).
destruct H3.
destruct x as [U].
exists U; repeat split; trivial.
pose proof (H3 (intro_neighborhood_net_DS X x0 U x o i H4)).
apply H5.
simpl; auto with sets.
Qed.

End Nets_and_continuity.

Section Subnet.

Variable X:TopologicalSpace.
Variable I:DirectedSet.
Variable x:Net I X.

Inductive Subnet {J:DirectedSet} : Net J X -> Prop :=
| intro_subnet: forall h:DS_set J -> DS_set I,
(forall j1 j2:DS_set J, DS_ord j1 j2 ->
DS_ord (h j1) (h j2)) ->
(exists arbitrarily large i:DS_set I,
exists j:DS_set J, h j = i) ->
Subnet (fun j:DS_set J => x (h j)).

Lemma subnet_limit: forall (x0:point_set X) {J:DirectedSet}
(y:Net J X), net_limit x x0 -> Subnet y ->
net_limit y x0.
Proof. hammer_hook "Nets" "Nets.subnet_limit".
intros.
destruct H0.
red; intros.
pose proof (H U H2 H3).
destruct H4.
destruct (H1 x1).
destruct H5.
destruct H6.
exists x3.
intros.
apply H4.
apply preord_trans with x2.
apply DS_ord_cond.
assumption.
rewrite <- H6.
apply H0.
assumption.
Qed.

Lemma subnet_cluster_point: forall (x0:point_set X) {J:DirectedSet}
(y:Net J X), net_cluster_point y x0 ->
Subnet y -> net_cluster_point x x0.
Proof. hammer_hook "Nets" "Nets.subnet_cluster_point".
intros.
destruct H0 as [h h_increasing h_dominant].
red; intros.
red; intros.
pose proof (h_dominant i).
destruct H2.
destruct H2.
destruct H3.
pose proof (H U H0 H1 x2).
destruct H4.
destruct H4.
exists (h x3).
split; trivial.
apply preord_trans with x1.
apply DS_ord_cond.
assumption.
rewrite <- H3.
apply h_increasing; assumption.
Qed.

Section cluster_point_subnet.

Variable x0:point_set X.
Hypothesis x0_cluster_point: net_cluster_point x x0.
Hypothesis I_nonempty: inhabited (DS_set I).

Record cluster_point_subnet_DS_set : Type := {
cps_i:DS_set I;
cps_U:Ensemble (point_set X);
cps_U_open_neigh: open_neighborhood cps_U x0;
cps_xi_in_U: In cps_U (x cps_i)
}.

Definition cluster_point_subnet_DS_ord
(iU1 iU2 : cluster_point_subnet_DS_set) : Prop :=
DS_ord (cps_i iU1) (cps_i iU2) /\
Included (cps_U iU2) (cps_U iU1).

Definition cluster_point_subnet_DS : DirectedSet.
refine (Build_DirectedSet
cluster_point_subnet_DS_set
cluster_point_subnet_DS_ord
_ _).
constructor.
red; intros; split; auto with sets.
apply preord_refl.
apply DS_ord_cond.
red; intros.
destruct H; destruct H0.
red; split; auto with sets.
apply preord_trans with (cps_i y); trivial.
apply DS_ord_cond.

intros.
destruct i as [i0 U0 ? ?]; destruct j as [i1 U1 ? ?].
destruct (DS_join_cond i0 i1).
destruct H.
pose proof (x0_cluster_point
(Intersection U0 U1)).
match type of H1 with | _ -> _ -> ?C =>
assert C end.
apply H1.
apply open_intersection2;
(apply cps_U_open_neigh0 ||
apply cps_U_open_neigh1).
constructor;
(apply cps_U_open_neigh0 ||
apply cps_U_open_neigh1).
destruct (H2 x1).
destruct H3.
pose (ki := x2).
pose (kU := Intersection U0 U1).
assert (open_neighborhood kU x0).
split.
apply open_intersection2.
apply cps_U_open_neigh0.
apply cps_U_open_neigh1.
constructor; (apply cps_U_open_neigh0 ||
apply cps_U_open_neigh1).
assert (In kU (x ki)).
exact H4.

exists (Build_cluster_point_subnet_DS_set
ki kU H5 H6).
split; red; simpl; split.
apply preord_trans with x1; trivial.
apply DS_ord_cond.
red; intros.
destruct H7; trivial.
apply preord_trans with x1; trivial.
apply DS_ord_cond.
red; intros.
destruct H7; trivial.
Defined.

Definition cluster_point_subnet : Net
cluster_point_subnet_DS X :=
fun (iU:DS_set cluster_point_subnet_DS) =>
x (cps_i iU).

Lemma cluster_point_subnet_is_subnet:
Subnet cluster_point_subnet.
Proof. hammer_hook "Nets" "Nets.cluster_point_subnet_is_subnet".
constructor.
intros.
destruct j1; destruct j2.
simpl in H; simpl.
red in H; tauto.

red; intros.
exists i; split.
apply preord_refl; apply DS_ord_cond.
assert (open_neighborhood Full_set x0).
split.
apply open_full.
constructor.
assert (In Full_set (x i)).
constructor.
exists (Build_cluster_point_subnet_DS_set
i Full_set H H0).
trivial.
Qed.

Lemma cluster_point_subnet_converges:
net_limit cluster_point_subnet x0.
Proof. hammer_hook "Nets" "Nets.cluster_point_subnet_converges".
red; intros.
destruct I_nonempty as [i0].
destruct (x0_cluster_point U H H0 i0).
destruct H1.
assert (open_neighborhood U x0).
split; trivial.
exists (Build_cluster_point_subnet_DS_set
x1 U H3 H2).
intros.
destruct j.
red in H4; simpl in H4.
red in H4; simpl in H4.
unfold cluster_point_subnet; simpl.
destruct H4; auto with sets.
Qed.

Lemma net_cluster_point_impl_subnet_converges:
exists J:DirectedSet, exists y:Net J X,
Subnet y /\ net_limit y x0.
Proof. hammer_hook "Nets" "Nets.net_cluster_point_impl_subnet_converges".
exists cluster_point_subnet_DS.
exists cluster_point_subnet.
split.
exact cluster_point_subnet_is_subnet.
exact cluster_point_subnet_converges.
Qed.

End cluster_point_subnet.

End Subnet.


Require Export "ProofObjects".

Check ev_SS.
Check nat_ind ev ev_O.
(*
ev_SS
     : forall n : nat, ev n -> ev (S (S n))
 *)

Check nat_ind.

(*
nat_ind
     : forall P : nat -> Prop,
       P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n
 *)

Theorem mult_0_r' : forall n:nat,
                      n * 0 = 0.
Proof.
  apply nat_ind. Show Proof.
  Case "O". SearchAbout ( _ * O = O ). apply mult_O_r.
  Show Proof.
  Case "n = S".
  simpl. intros n H. assumption.
Qed.

Theorem plus_one_r' : forall n:nat,
  n + 1 = S n.
Proof.
  apply nat_ind. Show Proof.
  Case "O". reflexivity. Show Proof.
  Case "S".
  intros n IHn'. simpl. apply f_equal. assumption. Show Proof.
Qed.

Inductive yesno : Type :=
  | yes : yesno
  | no : yesno.

Check yesno_ind.

Inductive rgb : Type :=
  | red : rgb
  | green : rgb
  | blue : rgb.
Check rgb_ind.

Inductive natlist : Type :=
  | nnil : natlist
  | ncons : nat -> natlist -> natlist.

Check natlist_ind.

Inductive natlist1 : Type :=
  | nnil1 : natlist1
  | nsnoc1 : natlist1 -> nat -> natlist1.
Check natlist1_ind.

Inductive byntree : Type :=
 | bempty : byntree
 | bleaf : yesno -> byntree
 | nbranch : yesno -> byntree -> byntree -> byntree.
Print byntree_ind.

(*
 ExSet_ind :
         ∀P : ExSet → Prop,
             (∀b : bool, P (con1 b)) →
             (∀(n : nat) (e : ExSet), P e → P (con2 n e)) →
             ∀e : ExSet, P e *)

Inductive ExSet :=
| con1 : bool -> ExSet
| con2 : nat -> ExSet -> ExSet.
Print ExSet_ind.

Inductive list (X:Type) : Type :=
        | nil : list X
        | cons : X -> list X -> list X.
Print list_ind.

Inductive tree (X:Type) : Type :=
  | leaf : X -> tree X
  | node : tree X -> tree X -> tree X.
Check tree_ind.

(*

mytype_ind :
        ∀(X : Type) (P : mytype X → Prop),
            (∀x : X, P (constr1 X x)) →
            (∀n : nat, P (constr2 X n)) →
            (∀m : mytype X, P m →
               ∀n : nat, P (constr3 X m n)) →
            ∀m : mytype X, P m *)
Inductive mytype ( X : Type ) : Type :=
| constr1 : X -> mytype X
| constr2 : nat -> mytype X
| constr3 : mytype X -> nat -> mytype X.
Print mytype_ind.

(*
mytype_ind =
fun (X : Type) (P : mytype X -> Prop) => mytype_rect X P
     : forall (X : Type) (P : mytype X -> Prop),
       (forall x : X, P (constr1 X x)) ->
       (forall n : nat, P (constr2 X n)) ->
       (forall m : mytype X, P m -> forall n : nat, P (constr3 X m n)) ->
       forall m : mytype X, P m
 *)

(*

 foo_ind :
        ∀(X Y : Type) (P : foo X Y → Prop),
             (∀x : X, P (bar X Y x)) →
             (∀y : Y, P (baz X Y y)) →
             (∀f1 : nat → foo X Y,
               (∀n : nat, P (f1 n)) → P (quux X Y f1)) →
             ∀f2 : foo X Y, P f2   *)
Inductive foo ( X Y : Type ) : Type :=
| bar : X ->  foo X Y
| baz : Y -> foo X Y
| quxx : ( nat -> foo X Y ) -> foo X Y.
Print foo_ind.

(*
foo_ind =
fun (X Y : Type) (P : foo X Y -> Prop) => foo_rect X Y P
     : forall (X Y : Type) (P : foo X Y -> Prop),
       (forall x : X, P (bar X Y x)) ->
       (forall y : Y, P (baz X Y y)) ->
       (forall f1 : nat -> foo X Y,
        (forall n : nat, P (f1 n)) -> P (quxx X Y f1)) ->
       forall f2 : foo X Y, P f2

Argument scopes are [type_scope type_scope _ _ _ _ _]

 *)

Inductive foo' (X:Type) : Type :=
  | C1 : list X -> foo' X -> foo' X
  | C2 : foo' X.

Print foo'_ind.

Lemma pred_of_positive : forall n, 1 <= n -> exists p : nat , n = S p.
Proof.
  intros n H. induction n. inversion H.
  exists n. reflexivity.
Qed.

Definition pred_spec (n:nat) :=
  { m : nat | n = 0 /\ m = 0 \/ n = S m }.

Definition predecessor : forall n : nat , pred_spec n.
  intros n. induction n.
  unfold pred_spec. exists 0. left. split. reflexivity. reflexivity.
  unfold pred_spec. exists n. right. reflexivity.
Defined.

Check { m : nat | 2 = S 1 }.

Extraction pred_spec.
Extraction predecessor.

Inductive prop : Prop :=
  prop_intro : Prop -> prop.
Check ( prop_intro prop ).

Theorem le_reverse_rules :
  forall n m : nat, n <= m -> n = m \/ exists p, n <= p /\ m = S p.
Proof.
  intros n m H. inversion H. left. reflexivity.
  right. exists m0. split. assumption. reflexivity.
Qed.


Require Export P09.

Theorem distr_rev : forall l1 l2 : natlist,
  rev (l1 ++ l2) = (rev l2) ++ (rev l1).
Proof.
  intros l1 l2. induction l1.
  - simpl. rewrite -> app_nil_end. reflexivity.
  - simpl. rewrite -> snoc_append. rewrite -> snoc_append. rewrite -> IHl1. rewrite <- app_assoc. reflexivity.
Qed.


Welcome to Coq 8.4pl4 (November 2015)

Coq < Definition doit3times {X:Type} (f:X -> X) (n:X) : X := f (f (f n)).
doit3times is defined

Coq < Check @doit3times.
doit3times
     : forall X : Type, (X -> X) -> X -> X

Coq < Definition minustwo (n : nat) : nat := match n with | O => O | S O => O | S (S n') => n' end.
minustwo is defined

Coq < Example test_doit3times: doit3times minustwo 9 = 3.
1 subgoal

  ============================
   doit3times minustwo 9 = 3

test_doit3times < reflexivity.
No more subgoals.

test_doit3times < Qed.
reflexivity.

test_doit3times is defined

Coq < Example test_doit3times'': doit3times minustwo 9 = 3.
1 subgoal

  ============================
   doit3times minustwo 9 = 3

test_doit3times'' < info_auto.
(* info auto : *)
 apply @eq_refl.
No more subgoals.

test_doit3times'' < Qed.
info_auto.

test_doit3times'' is defined

Coq < Definition negb (b:bool) : bool := match b with | true => false | false => true end.
negb is defined

Coq < Example test_doit3times': doit3times negb true = false.
1 subgoal

  ============================
   doit3times negb true = false

test_doit3times' < Proof.
1 subgoal

  ============================
   doit3times negb true = false

test_doit3times' < reflexivity.
No more subgoals.

test_doit3times' < Qed.
reflexivity.

test_doit3times' is defined

Coq < Notation "x :: l" := (cons l) (at level 60, right associativity).
Error: x is unbound in the right-hand side.

Coq < Notation "x :: l" := (cons x l) (at level 60, right associativity).

Coq < Notation "[ ]" := nil.
Setting notation at level 0.

Coq < Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).
Setting notation at level 0.

Coq < Fixpoint filter {X:Type} (test: X -> bool) (l:list X) : (list X) := match l with | [] => [] | h :: t => if test h then h :: (filter test t) else filter test t end.
filter is recursively defined (decreasing on 3rd argument)

Coq < Fixpoint evenb (n:nat) : bool := match n with | O => true | S O => false | S (S n') => evenb n' end.
evenb is recursively defined (decreasing on 1st argument)

Coq < Example test_filter1: filter evenb [1;2;3;4] = [2;4].
1 subgoal

  ============================
   filter evenb [1; 2; 3; 4] = [2; 4]

test_filter1 < Proof.
1 subgoal

  ============================
   filter evenb [1; 2; 3; 4] = [2; 4]

test_filter1 < reflexivity.
No more subgoals.

test_filter1 < Qed.
reflexivity.

test_filter1 is defined

Coq < Fixpoint beq_nat (n m : nat) : bool := match n with | O => match m with | O => true | S m' => false end | S n' => match m with | O => false | S m' => beq_nat n' m' end end.
beq_nat is recursively defined (decreasing on 1st argument)

Coq < Definition length_is_1 {X : Type} (l : list X) : bool := beq_nat (length l) 1.
length_is_1 is defined

Coq < Example test_filter2: filter length_is_1 [ [1;2]; [3]; [4]; [5;6;7]; []; [8] ] = [ [3]; [4]; [8] ].
1 subgoal

  ============================
   filter length_is_1 [[1; 2]; [3]; [4]; [5; 6; 7]; []; [8]] =
   [[3]; [4]; [8]]

test_filter2 < Proof.
1 subgoal

  ============================
   filter length_is_1 [[1; 2]; [3]; [4]; [5; 6; 7]; []; [8]] =
   [[3]; [4]; [8]]

test_filter2 < reflexivity.
No more subgoals.

test_filter2 < Qed.
reflexivity.

test_filter2 is defined

Coq < Definition oddb (n:nat) : bool := negb (evenb n).
oddb is defined

Coq < Definition countoddmembers' (l:list nat) : nat := length (filter oddb l).
countoddmembers' is defined

Coq < Example test_countoddmembers'1: countoddmembers' [1;0;3;1;4;5] = 4.
1 subgoal

  ============================
   countoddmembers' [1; 0; 3; 1; 4; 5] = 4

test_countoddmembers'1 < Proof.
1 subgoal

  ============================
   countoddmembers' [1; 0; 3; 1; 4; 5] = 4

test_countoddmembers'1 < reflexivity.
No more subgoals.

test_countoddmembers'1 < Qed.
reflexivity.

test_countoddmembers'1 is defined

Coq < Example test_countoddmembers'2: countoddmembers' [0;2;4] = 0.
1 subgoal

  ============================
   countoddmembers' [0; 2; 4] = 0

test_countoddmembers'2 < Proof.
1 subgoal

  ============================
   countoddmembers' [0; 2; 4] = 0

test_countoddmembers'2 < reflexivity.
No more subgoals.

test_countoddmembers'2 < Qed.
reflexivity.

test_countoddmembers'2 is defined

Coq < Example test_countoddmembers'3: countoddmembers' nil = 0.
1 subgoal

  ============================
   countoddmembers' [] = 0

test_countoddmembers'3 < Proof.
1 subgoal

  ============================
   countoddmembers' [] = 0

test_countoddmembers'3 < reflexivity.
No more subgoals.

test_countoddmembers'3 < Qed.
reflexivity.

test_countoddmembers'3 is defined

Coq < Example test_anon_fun': doit3times (fun n => n * n) 2 = 256.
1 subgoal

  ============================
   doit3times (fun n : nat => n * n) 2 = 256

test_anon_fun' < Proof.
1 subgoal

  ============================
   doit3times (fun n : nat => n * n) 2 = 256

test_anon_fun' < reflexivity.
No more subgoals.

test_anon_fun' < Qed.
reflexivity.

test_anon_fun' is defined

Coq < Example test_filter2': filter (fun l => beq_nat (length l) 1) [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] = [ [3]; [4]; [8] ].
1 subgoal

  ============================
   filter (fun l : list nat => beq_nat (length l) 1)
     [[1; 2]; [3]; [4]; [5; 6; 7]; []; [8]] = [[3]; [4]; [8]]

test_filter2' < Proof.
1 subgoal

  ============================
   filter (fun l : list nat => beq_nat (length l) 1)
     [[1; 2]; [3]; [4]; [5; 6; 7]; []; [8]] = [[3]; [4]; [8]]

test_filter2' < reflexivity.
No more subgoals.

test_filter2' < Qed.
reflexivity.

test_filter2' is defined


(* (c) Copyright Microsoft Corporation and Inria. You may distribute   *)
(* under the terms of either the CeCILL-B License or the CeCILL        *)
(* version 2 License, as specified in the README file.                 *)
Require Import ssreflect.
Require Import ssrfun.
Require Export Bool.

(*****************************************************************************)
(* A theory of boolean predicates and operators. A large part of this file   *)
(* is concerned with boolean reflection. Definitions and notations:          *)
(*                                                                           *)
(* a && b                  == boolean conjection                             *)
(* a || b                  == boolean disjunction                            *)
(* a ==> b                 == boolean implication                            *)
(* ~~ a                    == boolean negation                               *)
(* a (+) b                 == boolean xor                                    *)
(* is_true                 == coercion bool >-> Prop                         *)
(* reflect                 == the reflection inductive predicate             *)
(* iffP,...                == user-oriented reflection lemmas                *)
(* elimT                   == coercion reflect >-> Funclass, to apply        *)
(*                            reflection lemmas to boolean assertions        *)
(* [ /\ P1 , P2 & P3 ]     == iterated logical conjonction, up to 5          *)
(* [ \/ P1 , P2 & P3 ]     == iterated logical disjonction, up to 4          *)
(* [&& a, b, c & d]        == iterated, right associated boolean conjunction *)
(*                            with arbitrary arity                           *)
(* [|| a, b, c | d]        == iterated, right associated boolean disjunction *)
(*                            with arbitrary arity                           *)
(* [==> a, b, c => d]      == iterated, right associated boolean             *)
(*                            implication with arbitrary arity               *)
(* and3P,...               == specific reflection lemmas for iterated        *)
(*                            connectives                                    *)
(* andTb, orbAC,...        == systematic names for boolean connective        *)
(*                            properties                                     *)
(* 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                == T -> bool                                      *)
(*   simpl_pred T          == type of simplifying (see ssrfun) predicates    *)
(*   rel T                 == T -> pred T == T -> T -> bool                  *)
(*   simpl_rel T           == type of simplifying relations                  *)
(*   predType              == generic predicate interface,                   *)
(*                             implemented for lists, 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 mixed. Explicit values of   *)
(* pred T (i.e., lamdba terms) should always be used applicatively, while    *)
(* values of collection types implementing the predType interface, such as   *)
(* lists or sets should always be used as collective predicates; simpl_pred  *)
(* predicates are the only type that can be used either way (however, the    *)
(* x \in A notation will not simplify). We provide the following conversions *)
(*   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:                                                            *)
(*                                                                           *)
(* [pred x | E]            == simplifying (see ssrfun) predicate x => E      *)
(* [pred x : T| E]         == predicate x => T, with a cast on the argument  *)
(* [pred : T | E]          == constant predicate E on type T                 *)
(* [pred x \in A]          == [pred x | x \in A]                             *)
(* [pred x \in A | E]      == [pred x | (x \in A) && E]                      *)
(*                                                                           *)
(* [predU A & B]           == union of two collective predicates             *)
(* [predI A & B]           == intersection of collective predicates          *)
(* [predD A & B]           == difference of collective predicates            *)
(* [predC A]               == complement of a collective predicate           *)
(* [preim f of A]          == preimage by 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})    *)
(*                                                                           *)
(* [rel x y | E]           == simplifying relation                           *)
(* [rel x y : T | E]       == relation, with a cast on the arguments         *)
(* [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                     *)
(*                                                                           *)
(* 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                        *)
(*                                                                           *)
(* reflexive R             == R (in rel T) is reflexive                      *)
(* irreflexive R           == R (in rel T) is irreflexive                    *)
(* symmetric R             == R (in rel T) is symmetric (equational)         *)
(* pre_symmetric R         == R (in rel T) is symmetric (implication)        *)
(* antisymmetric R         == R (in rel T) is antisymmetric                  *)
(* total R                 == R (in rel T) is total                          *)
(* transitive R            == R (in rel T) is transitive                     *)
(* left_transitive R       == R is a congruence on the left hand side of R   *)
(* right_transitive R      == R is a congruence on the right hand side of R  *)
(*                                                                           *)
(* 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 :                      *)
(*                                                                           *)
(* {in d , P1}            == forall x, x \in d -> Qx                         *)
(* {in d1 & d2 , P2}      == forall x y, x \in d1 -> y \in d2 -> Qxy         *)
(* {in d & , P2}          == forall x y, x \in d -> y \in d -> Qxy           *)
(* {in d1 & d2 &, Q3}     == forall x y z,                                   *)
(*                            x \in d1 -> y \in d2 -> z \in d2 -> Qxyz       *)
(*                            + Variants                                     *)
(* {in d, bijective f}    == f has a right inverse in d                      *)
(* {on cd, P1}            == forall x, (f x) \in cd -> Qx                    *)
(*                            when P1 is also convertible to Pf f            *)
(* {on cd &, P2}          == forall x y, f x \in cd -> f y \in cd -> Qxy     *)
(*                            when P2 is also convertible to Pf f            *)
(* {on cd, 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 cd, bijective f}    == f has a right inverse on cd                    *)
(*                                                                           *)
(* This file introduces the following suffix policy for lemma names:         *)
(* A : associativity                                                         *)
(* C : commutativity or set complement                                       *)
(* D : set difference                                                        *)
(* E : elimination                                                           *)
(* F : boolean false                                                         *)
(* I : set intersection                                                      *)
(* K : cancellation                                                          *)
(* N : boolean negation                                                      *)
(* T : boolean truth                                                         *)
(* U : set union                                                             *)
(* W : weakening                                                             *)
(*****************************************************************************)

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

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, no associativity).
Reserved Notation "x \notin A" (at level 70, no associativity).
Reserved Notation "p1 =i p2" (at level 70, no associativity).

(* We introduce a number of n-ary "list-style" notations, which 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; for similar reasons the separator cannot be omitted even     *)
(* when last_arg can. The Notation declarations are complicated by the  *)
(* separate treatments for fixed arities (binary for bool operators,    *)
(* and all arities for Prop operators).                                 *)
(*   We also use the square brackets in comprehension-style notations   *)
(* of the form                                                          *)
(*    [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 by an operator symbol or at least *)
(* 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.

(* The Coq library forgets to set argument scopes on bool ops. *)

Arguments Scope negb [bool_scope].
Arguments Scope orb [bool_scope bool_scope].
Arguments Scope xorb [bool_scope bool_scope].
Arguments Scope andb [bool_scope bool_scope].
Arguments Scope implb [bool_scope bool_scope].
Arguments Scope eqb [bool_scope bool_scope].
Arguments Scope leb [bool_scope bool_scope].
Arguments Scope ifb [bool_scope bool_scope bool_scope].

(* An alternative to xorb that behaves somewhat better wrt simplification. *)

Definition addb b := if b then negb else fun b' => b'.

(* Bool operator notation; we need to redeclare && and || so they get the *)
(* correct argument scopes.                                               *)

Notation "~~ b" := (negb b) : bool_scope.
(* Redundant for now; may be added if dependency on Bool is removed
Notation "b1 && b2" := (andb b1 b2) : bool_scope.
Notation "b1 || b2" := (orb b1 b2) : bool_scope.
*)
Notation "b ==> c" := (implb b c) : bool_scope.
Notation "b1 (+) b2" := (addb b1 b2) : bool_scope.

(* Coercion bool >-> Prop.                    *)

Coercion is_true b := b = true.

(*
Ltac fold_prop := match goal with |- (?b = true) => change (is_true b) end.
*)
Lemma prop_congr : forall b b' : bool, b = b' -> b = b' :> Prop.
Proof. by move=> b b' ->. Qed.

Ltac prop_congr := apply: prop_congr.

(* Lemmas for auto. *)
Lemma is_true_true : true.               Proof. by []. Qed.
Lemma not_false_is_true : ~ false.       Proof. by []. Qed.
Lemma is_true_locked_true : locked true. Proof. by unlock. Qed.
Hint Resolve is_true_true not_false_is_true is_true_locked_true.

(* Negation lemmas. *)

(* Note: in the general we take NEGATION as the standard form of a *)
(* false condition : hypotheses should be of the form ~~ b rather  *)
(* than b = false or ~ b, as much as possible.                     *)

Lemma negbT : forall b, b = false -> ~~ b.        Proof. by case. Qed.
Lemma negbTE : forall b, ~~ b -> b = false.       Proof. by case. Qed.
Lemma negbF : forall b : bool, b -> ~~ b = false. Proof. by case. Qed.
Lemma negbFE : forall b, ~~ b = false -> b.       Proof. by case. Qed.
Lemma negbK : involutive negb.                    Proof. by case. Qed.
Lemma negbNE : forall b, ~~ ~~ b -> b.            Proof. by case. Qed.

Lemma negb_inj : injective negb. Proof. exact: can_inj negbK. Qed.

Lemma negbLR : forall b c, b = ~~ c -> ~~ b = c.
Proof. by move=> ? [] ->. Qed.

Lemma negbRL : forall b c, ~~ b = c -> b = ~~ c.
Proof. by move=> [] ? <-. Qed.

Lemma contra : forall c b : bool, (c -> b) -> ~~ b -> ~~ c.
Proof. by case=> // ? ->. Qed.

(* Coercion of sum-style datatypes into bool, which makes it possible *)
(* to use ssr's boolean if rather than Coq's "generic" if.            *)

Coercion isSome T (u : option T) := if u is Some _ then true else false.

Coercion is_inl A B (u : A + B) := if u is inl _ then true else false.

Coercion is_left A B (u : {A} + {B}) := if u is left _ then true else false.

Coercion is_inleft A B (u : A + {B}) := if u is inleft _ then true else false.

Prenex Implicits  isSome is_inl is_left is_inleft.

(* Lemmas for ifs with large conditions, which allow reasoning about the  *)
(* condition without repeating it inside the proof (the latter IS         *)
(* preferable when the condition is short).                               *)
(* Usage :                                                                *)
(*   if the goal contains (if cond then ...) = ...                        *)
(*     case: ifP => Hcond.                                                *)
(*   generates two subgoal, with the assumption Hcond : cond = true/false *)
(*     Rewrite if_same  eliminates redundant ifs                          *)
(*     Rewrite (fun_if f) moves a function f inside an if                 *)
(*     Rewrite if_arg moves an argument inside a function-valued if       *)

Section BoolIf.

Variables (A B : Type) (x : A) (f : A -> B) (b : bool) (vT vF : A).

CoInductive if_spec : A -> bool -> Set :=
  | IfSpecTrue  of b         : if_spec vT true
  | IfSpecFalse of b = false : if_spec vF false.

Lemma ifP : if_spec (if b then vT else vF) b.
Proof. by case Db: b; constructor. Qed.

Lemma if_same : (if b then vT else vT) = vT.
Proof. by case b. Qed.

Lemma if_neg : (if ~~ b then vT else vF) = if b then vF else vT.
Proof. by case b. Qed.

Lemma fun_if : f (if b then vT else vF) = if b then f vT else f vF.
Proof. by case b. Qed.

Lemma if_arg : forall fT fF : A -> B,
  (if b then fT else fF) x = if b then fT x else fF x.
Proof. by case b. Qed.

(* Patch for a bug in ssreflect 8.1 that corrupts patterns where a *)
(* wildcard appears under a match. Usage:                          *)
(*   rewrite -ifE; set x := if_expr _ _ _.                         *)

Definition if_expr := if b then vT else vF.
Lemma ifE : (if b then vT else vF) = if_expr. Proof. by []. Qed.

End BoolIf.

(* The reflection predicate.                                          *)

Inductive reflect (P : Prop) : bool -> Set :=
  | ReflectT  of   P : reflect P true
  | ReflectF of ~ P : reflect P false.

(* Core (internal) reflection lemmas, used for the three kinds of views. *)

Section ReflectCore.

Variables (P Q : Prop) (b c : bool).

Hypothesis Hb : reflect P b.

Lemma introNTF : (if c then ~ P else P) -> ~~ b = c.
Proof. by case c; case Hb. Qed.

Lemma introTF : (if c then P else ~ P) -> b = c.
Proof. by case c; case Hb. Qed.

Lemma elimNTF : ~~ b = c -> if c then ~ P else P.
Proof. by move <-; case Hb. Qed.

Lemma elimTF : b = c -> if c then P else ~ P.
Proof. by move <-; case Hb. Qed.

Lemma equivPif : (Q -> P) -> (P -> Q) -> if b then Q else ~ Q.
Proof. by case Hb; auto. Qed.

Lemma xorPif : Q \/ P -> ~ (Q /\ P) -> if b then ~ Q else Q.
Proof. by case Hb => [? _ H ? | ? H _]; case: H. Qed.

End ReflectCore.

(* Internal negated reflection lemmas *)
Section ReflectNegCore.

Variables (P Q : Prop) (b c : bool).
Hypothesis Hb : reflect P (~~ b).

Lemma introTFn : (if c then ~ P else P) -> b = c.
Proof. by move/(introNTF Hb) <-; case b. Qed.

Lemma elimTFn : b = c -> if c then ~ P else P.
Proof. by move <-; apply: (elimNTF Hb); case b. Qed.

Lemma equivPifn : (Q -> P) -> (P -> Q) -> if b then ~ Q else Q.
Proof. rewrite -if_neg; exact: equivPif. Qed.

Lemma xorPifn : Q \/ P -> ~ (Q /\ P) -> if b then Q else ~ Q.
Proof. rewrite -if_neg; exact: xorPif. Qed.

End ReflectNegCore.

(* User-oriented reflection lemmas *)
Section Reflect.

Variables (P Q : Prop) (b b' c : bool).
Hypotheses (Pb : reflect P b) (Pb' : reflect P (~~ b')).

Lemma introT  : P -> b.            Proof. exact: introTF true _. Qed.
Lemma introF  : ~ P -> b = false.  Proof. exact: introTF false _. Qed.
Lemma introN  : ~ P -> ~~ b.       Proof. exact: introNTF true _. Qed.
Lemma introNf : P -> ~~ b = false. Proof. exact: introNTF false _. Qed.
Lemma introTn : ~ P -> b'.         Proof. exact: introTFn true _. Qed.
Lemma introFn : P -> b' = false.   Proof. exact: introTFn false _. Qed.

Lemma elimT  : b -> P.             Proof. exact: elimTF true _. Qed.
Lemma elimF  : b = false -> ~ P.   Proof. exact: elimTF false _. Qed.
Lemma elimN  : ~~ b -> ~P.         Proof. exact: elimNTF true _. Qed.
Lemma elimNf : ~~ b = false -> P.  Proof. exact: elimNTF false _. Qed.
Lemma elimTn : b' -> ~ P.          Proof. exact: elimTFn true _. Qed.
Lemma elimFn : b' = false -> P.    Proof. exact: elimTFn false _. Qed.

Lemma introP : (b -> Q) -> (~~ b -> ~ Q) -> reflect Q b.
Proof. by case b; constructor; auto. Qed.

Lemma iffP : (P -> Q) -> (Q -> P) -> reflect Q b.
Proof. by case: Pb; constructor; auto. Qed.

Lemma appP : reflect Q b -> P -> Q.
Proof. by move=> Qb; move/introT; case: Qb. Qed.

Lemma sameP : reflect P c -> b = c.
Proof. case; [exact: introT | exact: introF]. Qed.

Lemma decPcases : if b then P else ~ P. Proof. by case Pb. Qed.

Definition decP : {P} + {~ P}. by case: b decPcases; [left | right]. Defined.

End Reflect.

Hint View for move/ elimTF|3 elimNTF|3 elimTFn|3 introT|2 introTn|2 introN|2.

Hint View for apply/ introTF|3 introNTF|3 introTFn|3 elimT|2 elimTn|2 elimN|2.

Hint View for apply// equivPif|3 xorPif|3 equivPifn|3 xorPifn|3.

(* Allow the direct application of a reflection lemma to a boolean assertion.  *)
Coercion elimT : reflect >-> Funclass.

(* List notations for wider connectives; the Prop connectives have a fixed  *)
(* width so as to avoid iterated destruction (we go up to width 5 for /\,   *)
(* and width 4 for or. The bool connectives have arbitrary widths, but      *)
(* denote expressions that associate to the RIGHT. This is consistent with  *)
(* the right associativity of list expressions, and thus more convenient in *)
(* many proofs.                                                             *)

Inductive and3 (P1 P2 P3 : Prop) : Prop := And3 of P1 & P2 & P3.

Inductive and4 (P1 P2 P3 P4 : Prop) : Prop := And4 of P1 & P2 & P3 & P4.

Inductive and5 (P1 P2 P3 P4 P5 : Prop) : Prop :=
  And5 of P1 & P2 & P3 & P4 & P5.

Inductive or3 (P1 P2 P3 : Prop) : Prop := Or31 of P1 | Or32 of P2 | Or33 of P3.

Inductive or4 (P1 P2 P3 P4 : Prop) : Prop :=
  Or41 of P1 | Or42 of P2 | Or43 of P3 | Or44 of P4.

Notation "[ /\ P1 & P2 ]" := (and P1 P2) (only parsing) : type_scope.
Notation "[ /\ P1 , P2 & P3 ]" := (and3 P1 P2 P3) : type_scope.
Notation "[ /\ P1 , P2 , P3 & P4 ]" := (and4 P1 P2 P3 P4) : type_scope.
Notation "[ /\ P1 , P2 , P3 , P4 & P5 ]" := (and5 P1 P2 P3 P4 P5) : type_scope.

Notation "[ \/ P1 | P2 ]" := (or P1 P2) (only parsing) : type_scope.
Notation "[ \/ P1 , P2 | P3 ]" := (or3 P1 P2 P3) : type_scope.
Notation "[ \/ P1 , P2 , P3 | P4 ]" := (or4 P1 P2 P3 P4) : type_scope.

Notation "[ && b1 & c ]" := (b1 && c) (only parsing) : bool_scope.
Notation "[ && b1 , b2 , .. , bn & c ]" := (b1 && (b2 && .. (bn && c) .. ))
  : bool_scope.

Notation "[ || b1 | c ]" := (b1 || c) (only parsing) : bool_scope.
Notation "[ || b1 , b2 , .. , bn | c ]" := (b1 || (b2 || .. (bn || c) .. ))
  : bool_scope.

Notation "[ ==> b1 , b2 , .. , bn => c ]" :=
   (b1 ==> (b2 ==> .. (bn ==> c) .. )) : bool_scope.
Notation "[ ==> b1 => c ]" := (b1 ==> c) (only parsing) : bool_scope.

Section ReflectConnectives.

Variable b1 b2 b3 b4 b5 : bool.

Lemma idP : reflect b1 b1.
Proof. by case b1; constructor. Qed.

Lemma idPn : reflect (~~ b1) (~~ b1).
Proof. by case b1; constructor. Qed.

Lemma negP : reflect (~ b1) (~~ b1).
Proof. by case b1; constructor; auto. Qed.

Lemma negPn : reflect b1 (~~ ~~ b1).
Proof. by case b1; constructor. Qed.

Lemma negPf : reflect (b1 = false) (~~ b1).
Proof. by case b1; constructor. Qed.

Lemma andP : reflect (b1 /\ b2) (b1 && b2).
Proof. by case b1; case b2; constructor=> //; case. Qed.

Lemma and3P : reflect [/\ b1, b2 & b3] [&& b1, b2 & b3].
Proof. by case b1; case b2; case b3; constructor; try by case. Qed.

Lemma and4P : reflect [/\ b1, b2, b3 & b4] [&& b1, b2, b3 & b4].
Proof.
by case b1; case b2; case b3; case b4; constructor; try by case. Qed.

Lemma and5P : reflect [/\ b1, b2, b3, b4 & b5] [&& b1, b2, b3, b4 & b5].
Proof.
by case b1; case b2; case b3; case b4; case b5; constructor; try by case.
Qed.

Lemma orP : reflect (b1 \/ b2) (b1 || b2).
Proof. by case b1; case b2; constructor; auto; case. Qed.

Lemma or3P : reflect [\/ b1, b2 | b3] [|| b1, b2 | b3].
Proof.
case b1; first by constructor; constructor 1.
case b2; first by constructor; constructor 2.
case b3; first by constructor; constructor 3.
by constructor; case.
Qed.

Lemma or4P : reflect [\/ b1, b2, b3 | b4] [|| b1, b2, b3 | b4].
Proof.
case b1; first by constructor; constructor 1.
case b2; first by constructor; constructor 2.
case b3; first by constructor; constructor 3.
case b4; first by constructor; constructor 4.
by constructor; case.
Qed.

Lemma nandP : reflect (~~ b1 \/ ~~ b2) (~~ (b1 && b2)).
Proof. by case b1; case b2; constructor; auto; case; auto. Qed.

Lemma norP : reflect (~~ b1 /\ ~~ b2) (~~ (b1 || b2)).
Proof. by case b1; case b2; constructor; auto; case; auto. Qed.

Lemma implyP: reflect (b1 -> b2) (b1 ==> b2).
Proof. by case b1; case b2; constructor; auto. Qed.

End ReflectConnectives.

Implicit Arguments idP [b1].
Implicit Arguments idPn [b1].
Implicit Arguments negP [b1].
Implicit Arguments negPn [b1].
Implicit Arguments negPf [b1].
Implicit Arguments andP [b1 b2].
Implicit Arguments and3P [b1 b2 b3].
Implicit Arguments and4P [b1 b2 b3 b4].
Implicit Arguments and5P [b1 b2 b3 b4 b5].
Implicit Arguments orP [b1 b2].
Implicit Arguments or3P [b1 b2 b3].
Implicit Arguments or4P [b1 b2 b3 b4].
Implicit Arguments nandP [b1 b2].
Implicit Arguments norP [b1 b2].
Implicit Arguments implyP [b1 b2].
Prenex Implicits idP idPn negP negPn negPf.
Prenex Implicits andP and3P and4P and5P orP or3P or4P nandP norP implyP.

(* Shorter, more systematic names for the boolean connectives laws.       *)

Lemma andTb : left_id true andb.     Proof. by []. Qed.
Lemma andFb : left_zero false andb.    Proof. by []. Qed.
Lemma andbT : right_id true andb.    Proof. by case. Qed.
Lemma andbF : right_zero false andb.   Proof. by case. Qed.
Lemma andbb : idempotent andb.         Proof. by case. Qed.
Lemma andbC : commutative andb.        Proof. by do 2!case. Qed.
Lemma andbA : associative andb.        Proof. by do 3!case. Qed.
Lemma andbCA : left_commutative andb.  Proof. by do 3!case. Qed.
Lemma andbAC : right_commutative andb. Proof. by do 3!case. Qed.

Lemma orTb : forall b, true || b.      Proof. by []. Qed.
Lemma orFb : left_id false orb.      Proof. by []. Qed.
Lemma orbT : forall b, b || true.      Proof. by case. Qed.
Lemma orbF : right_id false orb.     Proof. by case. Qed.
Lemma orbb : idempotent orb.           Proof. by case. Qed.
Lemma orbC : commutative orb.          Proof. by do 2!case. Qed.
Lemma orbA : associative orb.          Proof. by do 3!case. Qed.
Lemma orbCA : left_commutative orb.    Proof. by do 3!case. Qed.
Lemma orbAC : right_commutative orb.   Proof. by do 3!case. Qed.

Lemma andbN : forall b, b && ~~ b = false. Proof. by case. Qed.
Lemma andNb : forall b, ~~ b && b = false. Proof. by case. Qed.
Lemma orbN : forall b, b || ~~ b = true.   Proof. by case. Qed.
Lemma orNb : forall b, ~~ b || b = true.   Proof. by case. Qed.

Lemma andb_orl : left_distributive andb orb.  Proof. by do 3!case. Qed.
Lemma andb_orr : right_distributive andb orb. Proof. by do 3!case. Qed.
Lemma orb_andl : left_distributive orb andb.  Proof. by do 3!case. Qed.
Lemma orb_andr : right_distributive orb andb. Proof. by do 3!case. Qed.

Lemma negb_and : forall b1 b2, ~~ (b1 && b2) = ~~ b1 || ~~ b2.
Proof. by do 2!case. Qed.

Lemma negb_or : forall b1 b2, ~~ (b1 || b2) = ~~ b1 && ~~ b2.
Proof. by do 2!case. Qed.

(* Pseudo-cancellation -- i.e, absorbtion *)

Lemma andbK : forall b1 b2, b1 && b2 || b1 = b1.  Proof. by do 2!case. Qed.
Lemma andKb : forall b1 b2, b1 || b2 && b1 = b1.  Proof. by do 2!case. Qed.
Lemma orbK : forall b1 b2, (b1 || b2) && b1 = b1. Proof. by do 2!case. Qed.
Lemma orKb : forall b1 b2, b1 && (b2 || b1) = b1. Proof. by do 2!case. Qed.

(* Imply *)

Lemma implybT : forall b, b ==> true.           Proof. by case. Qed.
Lemma implybF : forall b, (b ==> false) = ~~ b. Proof. by case. Qed.
Lemma implyFb : forall b, false ==> b.          Proof. by []. Qed.
Lemma implyTb : forall b, (true ==> b) = b.     Proof. by []. Qed.

Lemma negb_imply : forall b1 b2, ~~ (b1 ==> b2) = b1 && ~~ b2.
Proof. by do 2!case. Qed.

Lemma implybE : forall b1 b2, (b1 ==> b2) = ~~ b1 || b2.
Proof. by do 2!case. Qed.

Lemma implybN : forall b1 b2, (~~ b1 ==> ~~ b2) = b2 ==> b1.
Proof. by do 2!case. Qed.

(* addition (xor) *)

Lemma addFb : left_id false addb.             Proof. by []. Qed.
Lemma addbF : right_id false addb.            Proof. by case. Qed.
Lemma addbb : self_inverse false addb.          Proof. by case. Qed.
Lemma addbC : commutative addb.                 Proof. by do 2!case. Qed.
Lemma addbA : associative addb.                 Proof. by do 3!case. Qed.
Lemma addbCA : left_commutative addb.           Proof. by do 3!case. Qed.
Lemma addbAC : right_commutative addb.          Proof. by do 3!case. Qed.
Lemma andb_addl : left_distributive andb addb.  Proof. by do 3!case. Qed.
Lemma andb_addr : right_distributive andb addb. Proof. by do 3!case. Qed.
Lemma addKb : forall b, involutive (addb b).    Proof. by do 2!case. Qed.
Lemma addbK : forall b, involutive (addb^~ b).  Proof. by do 2!case. Qed.

Lemma addTb : forall b, true (+) b = ~~ b. Proof. by []. Qed.
Lemma addbT : forall b, b (+) true = ~~ b. Proof. by case. Qed.

Lemma addbN : forall b1 b2, b1 (+) ~~ b2 = ~~ (b1 (+) b2).
Proof. by do 2!case. Qed.
Lemma addNb : forall b1 b2, ~~ b1 (+) b2 = ~~ (b1 (+) b2).
Proof. by do 2!case. Qed.

Lemma addbP : forall b1 b2, b1 (+) b2 -> ~~ b1 = b2.
Proof. by do 2!case. Qed.

(* Resolution tactic for blindly weeding out common terms from boolean       *)
(* equalities. When faced with a goal of the form (andb/orb/addb b1 b2) = b3 *)
(* they will try to locate b1 in b3 and remove it. This can fail!            *)

Ltac bool_congr :=
  match goal with
  | |- (?X1 && ?X2 = ?X3) => first
  [ symmetry; rewrite -1?(andbC X1) -?(andbCA X1); congr 1 (andb X1); symmetry
  | case X1; [ rewrite ?andTb ?andbT | by rewrite /= ?andbF ] ]
  | |- (?X1 || ?X2 = ?X3) => first
  [ symmetry; rewrite -1?(orbC X1) -?(orbCA X1); congr 1 (orb X1); symmetry
  | case X1; [ by rewrite /= ?orbT | rewrite ?orFb ?orbF ] ]
  | |- (?X1 (+) ?X2 = ?X3) =>
    symmetry; rewrite -1?(addbC X1) -?(addbCA X1); congr 1 (addb X1); symmetry
  | |- (~~ ?X1 = ?X2) => congr 1 negb
  end.

(* Predicates, i.e., packaged functions to bool.                  *)
(*   Indeed, pred T, the basic type for predicates over a type T, *)
(* is simply an alias for T -> bool.                              *)
(*   We actually distinguish two kinds of predicates, which we    *)
(* applicative and collective, based on the syntax used to        *)
(* specialize them to some value x in T:                          *)
(*  - For an applicative predicate P, one uses prefix syntax:     *)
(*        P x                                                     *)
(*    Also, most operations on applicative predicates us prefix   *)
(*    syntax as well (e.g., predI P Q).                           *)
(*  - For a collective predicate A, one uses infix syntax:        *)
(*        x \in A                                                 *)
(*    and all operations on collective predicates use infix       *)
(*    syntax as well (e.g., [predI A & B]).                       *)
(* There are only two kinds of applicative predicates:            *)
(*  - pred T, the alias for T -> bool mentioned above             *)
(*  - simpl_pred T, an alias for simpl_fun T bool with a coercion *)
(*    to pred T that auto-simplifies on application (see ssrfun). *)
(* On the other hand, the set of collective predicate types is    *)
(* open-ended, via                                                *)
(*  - predType T, a Structure that can be used to put Canonical   *)
(*    collective predicate interpretation on other types, such    *)
(*    as lists, tuples, finite sets, etc.                         *)
(* Indeed, we define such interpretations for both applicative    *)
(* predicate types, which can therefore also be used with the     *)
(* infix syntax, e.g. x \in predI P Q. Moreover these infix forms *)
(* are convertible to their prefix counterpart (e.g., predI P Q x *)
(* which in turn simplifies to P x && Q x).                       *)
(*   The converse is not true, however; collective predicate      *)
(* types cannot, in general, be used applicatively, because of    *)
(* the "uniform inheritance" restriction on implicit coercion.    *)
(*   However, we do define an explicit generic coercion           *)
(*  - mem : forall (pT : predType), pT -> mem_pred T              *)
(*    where mem_pred T is a variant of simpl_pred T that          *)
(*    preserves the infix syntax, i.e.,                           *)
(*       mem A x auto-simplifies to x \in A                       *)
(* Indeed, the infix "collective" operators are notation for a    *)
(* prefix operator with arguments of type mem_pred T or pred T,   *)
(* applied to coerced collective predicates, e.g.,                *)
(*      Notation "x \in A" := (in_mem x (mem A)).                 *)
(* This prevents the variability in the predicate type from       *)
(* interfering with the application of generic lemmas. Moreover   *)
(* this also makes it much easier to define generic lemmas,       *)
(* because the simplest type -- pred T -- can be used as the type *)
(* of generic collective predicates, provided one takes care not  *)
(* to use it applicatively; this avoids the burden of having to   *)
(* declare a different predicate type for each predicate          *)
(* parameter of each section or lemma.                            *)
(*   This trick is made possible by the fact that the constructor *)
(* of the mem_pred T type aligns the unification process, forcing *)
(* a generic "collective" predicate A : pred T to unify with the  *)
(* actual collective B, which mem has coerced to pred T via an    *)
(* internal, hidden implicit coercion, supplied by the predType   *)
(* structure for B. Users should take care not to inadvertently   *)
(* "strip" (mem B) down to the coerced B, since this will expose  *)
(* the internal coercion: Coq will display a term B x that can't  *)
(* be typed as such. The topredE lemma can be used to restore the *)
(* x \in B syntax in this case. While -topredE can conversely be  *)
(* used to change x \in P into P x, it is safer to use the inE    *)
(* and memE lemmas instead, as they do not run the risk of        *)
(* exposing internal coercions. As a consequence, it is better to *)
(* explicitly cast a generic applicative pred T to simpl_pred,    *)
(* using the SimplPred constructor, when it is used as a          *)
(* collective predicate (see, e.g., Lemma eq_big in bigops.v).    *)
(*   We also sometimes "instantiate" the predType structure by    *)
(* defining a coercion to the sort of the predPredType structure. *)
(* This works better for types such as set T that have subtypes   *)
(* that coerce to them, since the same coercion will be inserted  *)
(* by the application of mem. It also allows us to turn some      *)
(* specific Types (namely, any aT : predArgType) into predicates, *)
(* specifically, the total predicate over that type, i.e.,        *)
(* fun _ : aT => true. This allows us to write, e.g.,  #|'I_n|    *)
(* for the cardinal of the (finite) type of integers less than n. *)
(*   Collective predicates have a specific extensional equality,  *)
(*     - A =i B,                                                  *)
(* while applicative predicates just use the extensional equality *)
(* of functions,                                                  *)
(*     - P =1 Q                                                   *)
(* The two forms are convertible, however.                        *)
(*   We lift boolean operations to predicates, defining:          *)
(*  - predU (union), predI (intersection), predC (complement),    *)
(*    predD (difference), and preim (preimage, i.e., composition) *)
(* For each operation we define three forms, typically:           *)
(*   - predU : pred T -> pred T -> simpl_pred T                   *)
(*   - [predU A & B], a Notation for predU (mem A) (mem B)        *)
(*   - xpredU, a Notation for the lambda-expression inside predU, *)
(*     which is mostly useful as an argument of =1, since it      *)
(*     exposes the head constant of the expression to the         *)
(*     ssreflect matching algorithm.                              *)
(* The syntax for the preimage of a collective predicate A is     *)
(*   - [preim f of A]                                             *)
(* Finally, the generic syntax for defining a simpl_pred T is     *)
(*   - [pred x : T | P(x)], [pred x | P(x)], [pred x \in A | P(x) *)
(* We also support boolean relations, but only the applicative    *)
(* form, with types                                               *)
(*   - rel T, an alias for T -> pred T                            *)
(*   - simpl_rel T, an auto-simplifying version, and syntax       *)
(*     [rel x y | P(x,y)], [rel x y \in A & B | P(x,y)], etc.     *)
(* The notation [rel of fA] can be used to coerce a function      *)
(* returning a collective predicate to one returning pred T.      *)

Definition pred T := T -> bool.

Identity Coercion fun_of_pred : pred >-> Funclass.

Definition rel T := T -> pred T.

Identity Coercion fun_of_rel : rel >-> Funclass.

Notation xpred0 := (fun _ => false).
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)).
Notation xrelU := (fun (r1 r2 : rel _) x y => r1 x y || r2 x y).

Section Predicates.

Variables T : Type.

Definition subpred (p1 p2 : pred T) := forall x, p1 x -> p2 x.

Definition subrel (r1 r2 : rel T) := forall x y, r1 x y -> r2 x y.

Definition simpl_pred := simpl_fun T bool.

Definition SimplPred (p : pred T) : simpl_pred := SimplFun p.

Coercion pred_of_simpl (p : simpl_pred) : pred T := p : T -> bool.

Definition pred0 := SimplPred xpred0.
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).

Definition simpl_rel := simpl_fun T (pred T).

Definition SimplRel (r : rel T) : simpl_rel := [fun x => r x].

Coercion rel_of_simpl_rel (r : simpl_rel) : rel T := fun x y => r x y.

Definition relU r1 r2 := SimplRel (xrelU r1 r2).

Lemma subrelUl : forall r1 r2, subrel r1 (relU r1 r2).
Proof. by move=> * ? *; apply/orP; left. Qed.

Lemma subrelUr : forall r1 r2, subrel r2 (relU r1 r2).
Proof. by move=> * ? *; apply/orP; right. Qed.

CoInductive mem_pred : Type := Mem of pred T.

Definition isMem pT topred mem := mem = (fun p : pT => Mem [eta topred p]).

Structure predType : Type := PredType {
  pred_sort :> Type;
  topred : pred_sort -> pred T;
  _ : {mem | isMem topred mem}
}.

Definition mkPredType pT toP := PredType (exist (@isMem pT toP) _ (erefl _)).

Canonical Structure predPredType := Eval hnf in @mkPredType (pred T) id.
Canonical Structure simplPredType := Eval hnf in mkPredType pred_of_simpl.

Coercion pred_of_mem mp : pred_sort predPredType :=
  let: Mem p := mp in [eta p].

Canonical Structure memPredType := Eval hnf in mkPredType pred_of_mem.

End Predicates.

Implicit Arguments pred0 [T].
Implicit Arguments predT [T].
Prenex Implicits pred0 predT predI predU predC predD preim relU.

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 "[ 'rel' x y | E ]" := (SimplRel (fun x y => E))
  (at level 0, x ident, y ident, format "[ 'rel'  x  y  |  E ]") : fun_scope.
Notation "[ 'rel' x y : T | E ]" := (SimplRel (fun x y : T => E))
  (at level 0, x ident, y ident, only parsing) : fun_scope.

Definition repack_pred T pT :=
  let: PredType _ a mP := pT return {type of @PredType T for pT} -> _ in
   fun k => k a mP.

Notation "[ 'predType' 'of' T ]" := (repack_pred (fun a => @PredType _ T a))
  (at level 0, format "[ 'predType'  'of'  T ]") : form_scope.

(* This redundant coercion lets us "inherit" the simpl_predType canonical *)
(* structure by declaring a coercion to simpl_pred. This hack is the only *)
(* way to put a predType structure on a predArgType. We use simpl_pred    *)
(* rather than pred to ensure that /= removes the identity coercion. Note *)
(* that the coercion will never be used directly for simpl_pred, since    *)
(* the canonical structure should always resolve.                         *)

Notation pred_class := (pred_sort (predPredType _)).
Coercion sort_of_simpl_pred T (p : simpl_pred T) : pred_class := p : pred T.

(* This lets us use some types as a synonym for their universal predicate. *)
(* Unfortunately, this won't work for existing types like bool, unless     *)
(* we redefine bool, true, false and all bool ops.                         *)
(*   We don't define a coercion to Sortclass because then any coercion to  *)
(* predArgType would always be in a conflict with a preexisting coercion   *)
(* to Sortclass.                                                           *)
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: PredType _ _ (exist mem _) := pT return pT -> _ in mem).
Definition in_mem T x mp := nosimpl pred_of_mem T mp x.

Prenex Implicits mem.

Coercion pred_of_mem_pred T mp := [pred x : T | in_mem x mp].

Definition eq_mem T p1 p2 := forall x : T, in_mem x p1 = in_mem x p2.
Definition sub_mem T p1 p2 := forall x : T, in_mem x p1 -> in_mem x p2.

Notation "x \in A" := (in_mem x (mem A)) : bool_scope.
Notation "x \in A" := (in_mem x (mem A)) : bool_scope.
Notation "x \notin A" := (~~ (x \in A)) : bool_scope.
Notation "A =i B" := (eq_mem (mem A) (mem B)) : type_scope.
Notation "{ 'subset' A <= B }" := (sub_mem (mem A) (mem B))
  (at level 0, A, B at level 69,
   format "{ '[hv' 'subset'  A '/   '  <=  B ']' }") : type_scope.
Notation "[ 'mem' A ]" := (pred_of_simpl (pred_of_mem_pred (mem A)))
  (at level 0, only parsing) : fun_scope.
Notation "[ 'rel' 'of' fA ]" := (fun x => [mem (fA x)])
  (at level 0, format "[ 'rel'  'of'  fA ]") : 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 "[ 'rel' x y \in A & B | E ]" :=
  [rel x y | (x \in A) && (y \in B) && E]
  (at level 0, x ident, y ident,
   format "[ 'rel'  x  y  \in  A  &  B  |  E ]") : fun_scope.
Notation "[ 'rel' x y \in A & B ]" := [rel x y | (x \in A) && (y \in B)]
  (at level 0, x ident, y ident,
   format "[ 'rel'  x  y  \in  A  &  B ]") : fun_scope.
Notation "[ 'rel' x y \in A | E ]" := [rel x y \in A & A | E]
  (at level 0, x ident, y ident,
   format "[ 'rel'  x  y  \in  A  |  E ]") : fun_scope.
Notation "[ 'rel' x y \in A ]" := [rel x y \in A & A]
  (at level 0, x ident, y ident,
   format "[ 'rel'  x  y  \in  A ]") : fun_scope.

Section simpl_mem.

Variables (T : Type) (pT : predType T).

Lemma mem_topred : forall (p : pT), mem (topred p) = mem p.
Proof. by rewrite /mem; case: pT => T1 app1 [mem1  /= ->]. Qed.

Lemma topredE : forall x (p : pT), topred p x = (x \in p).
Proof. by move=> *; rewrite -mem_topred. Qed.

Lemma in_simpl : forall x (p : simpl_pred T), (x \in p) = p x.
Proof. by []. Qed.

Lemma simpl_predE : forall (p : pred T), [pred x | p x] =1 p.
Proof. by []. Qed.

Definition inE := (in_simpl, simpl_predE). (* to be extended *)

Lemma mem_simpl : forall (p : simpl_pred T), mem p = p :> pred T.
Proof. by []. Qed.

Definition memE := mem_simpl. (* could be extended *)

Lemma mem_mem : forall p : pT, (mem (mem p) = mem p) * (mem [mem p] = mem p).
Proof. by move=> p; rewrite -mem_topred. Qed.

End simpl_mem.

Section RelationProperties.

(* Caveat: reflexive should not be used to state lemmas, since auto *)
(* and trivial will not expand the constant.                        *)

Variable T : Type.

Variable R : rel T.

Definition total := forall x y, R x y || R y x.
Definition transitive := forall y x z, R x y -> R y z -> R x z.

Definition symmetric := forall x y, R x y = R y x.
Definition antisymmetric := forall x y, R x y && R y x -> x = y.
Definition pre_symmetric := forall x y, R x y -> R y x.

Lemma symmetric_from_pre : pre_symmetric -> symmetric.
Proof. move=> symR x y; apply/idP/idP; exact: symR. Qed.

Definition reflexive := forall x, R x x.
Definition irreflexive := forall x, R x x = false.

Definition left_transitive := forall x y, R x y -> R x =1 R y.
Definition right_transitive := forall x y, R x y -> R^~ x =1 R^~ y.

End RelationProperties.

(* Property localization *)

Notation Local "{ 'all1' P }" := (forall x, P x : Prop) (at level 0).
Notation Local "{ 'all2' P }" := (forall x y, P x y : Prop) (at level 0).
Notation Local "{ 'all3' P }" := (forall x y z, P x y z: Prop) (at level 0).
Notation Local ph := (phantom _).

Section LocalProperties.

Variables T1 T2 T3 : Type.

Variables (d1 : mem_pred T1) (d2 : mem_pred T2) (d3 : mem_pred T3).
Notation Local ph := (phantom Prop).

Definition prop_in1 P & ph {all1 P} :=
  forall x, in_mem x d1 -> P x.

Definition prop_in11 P & ph {all2 P} :=
  forall x y, in_mem x d1 -> in_mem y d2 -> P x y.

Definition prop_in2 P & ph {all2 P} :=
  forall x y, in_mem x d1 -> in_mem y d1 -> P x y.

Definition prop_in111 P & ph {all3 P} :=
  forall x y z, in_mem x d1 -> in_mem y d2 -> in_mem z d3 -> P x y z.

Definition prop_in12 P & ph {all3 P} :=
  forall x y z, in_mem x d1 -> in_mem y d2 -> in_mem z d2 -> P x y z.

Definition prop_in21 P & ph {all3 P} :=
  forall x y z, in_mem x d1 -> in_mem y d1 -> in_mem z d2 -> P x y z.

Definition prop_in3 P & ph {all3 P} :=
  forall x y z, in_mem x d1 -> in_mem y d1 -> in_mem z d1 -> P x y z.

Variable f : T1 -> T2.

Definition prop_on1 Pf P & phantom T3 (Pf f) & ph {all1 P} :=
  forall x, in_mem (f x) d2 -> P x.

Definition prop_on2 Pf P & phantom T3 (Pf f) & ph {all2 P} :=
  forall x y, in_mem (f x) d2 -> in_mem (f y) d2 -> P x y.

End LocalProperties.

Definition inPhantom (P : Prop) := Phantom P.
Definition onPhantom T (P : T -> Prop) x := Phantom (P x).

Definition bijective_in aT rT (d : mem_pred aT) (f : aT -> rT) :=
  exists2 g, prop_in1 d (inPhantom (cancel f g))
           & prop_on1 d (Phantom (cancel g)) (onPhantom (cancel g) f).

Definition bijective_on aT rT (cd : mem_pred rT) (f : aT -> rT) :=
  exists2 g, prop_on1 cd (Phantom (cancel f)) (onPhantom (cancel f) g)
           & prop_in1 cd (inPhantom (cancel g f)).

Notation "{ 'in' d , P }" :=
  (prop_in1 (mem d) (inPhantom P))
  (at level 0, format "{ 'in'  d ,  P }") : type_scope.

Notation "{ 'in' d1 & d2 , P }" :=
  (prop_in11 (mem d1) (mem d2) (inPhantom P))
  (at level 0, format "{ 'in'  d1  &  d2 ,  P }") : type_scope.

Notation "{ 'in' d & , P }" :=
  (prop_in2 (mem d) (inPhantom P))
  (at level 0, format "{ 'in'  d  & ,  P }") : type_scope.

Notation "{ 'in' d1 & d2 & d3 , P }" :=
  (prop_in111 (mem d1) (mem d2) (mem d3) (inPhantom P))
  (at level 0, format "{ 'in'  d1  &  d2  &  d3 ,  P }") : type_scope.

Notation "{ 'in' d1 & & d3 , P }" :=
  (prop_in21 (mem d1) (mem d3) (inPhantom P))
  (at level 0, format "{ 'in'  d1  &  &  d3 ,  P }") : type_scope.

Notation "{ 'in' d1 & d2 & , P }" :=
  (prop_in12 (mem d1) (mem d2) (inPhantom P))
  (at level 0, format "{ 'in'  d1  &  d2  & ,  P }") : type_scope.

Notation "{ 'in' d & & , P }" :=
  (prop_in3 (mem d) (inPhantom P))
  (at level 0, format "{ 'in'  d  &  & ,  P }") : type_scope.

Notation "{ 'on' cd , P }" :=
  (prop_on1 (mem cd) (inPhantom P) (inPhantom P))
  (at level 0, format "{ 'on'  cd ,  P }") : type_scope.

Notation "{ 'on' cd & , P }" :=
  (prop_on2 (mem cd) (inPhantom P) (inPhantom P))
  (at level 0, format "{ 'on'  cd  & ,  P }") : type_scope.

Notation "{ 'on' cd , P & g }" :=
  (prop_on1 (mem cd) (Phantom P) (onPhantom P g))
  (at level 0, format "{ 'on'  cd ,  P  &  g }") : type_scope.

Notation "{ 'in' d , 'bijective' f }" := (bijective_in (mem d) f)
  (at level 0, f at level 8,
   format "{ 'in'  d ,  'bijective'  f }") : type_scope.

Notation "{ 'on' cd , 'bijective' f }" := (bijective_on (mem cd) f)
  (at level 0, f at level 8,
   format "{ 'on'  cd ,  'bijective'  f }") : type_scope.

(* Weakening and monotonicity lemmas for localized predicates. *)
(* Note that using these lemmas in backward reasoning will     *)
(* cause the expansion of the predicate definition, as Coq     *)
(* needs to expose the quantifier to apply these lemmas. We    *)
(* define some specialized variants to avoid this for some of  *)
(* the ssrfun definitions.                                     *)

Section LocalGlobal.

Variables T1 T2 T3 : predArgType.
Variables (D1 : pred T1) (D2 : pred T2) (D3 : pred T3).
Variables (d1 d1' : mem_pred T1) (d2 d2' : mem_pred T2) (d3 d3' : mem_pred T3).
Variables (f f' : T1 -> T2) (g : T2 -> T1) (h : T3).
Variables (P1 : T1 -> Prop) (P2 : T1 -> T2 -> Prop).
Variable P3 : T1 -> T2 -> T3 -> Prop.
Variable Q1 : (T1 -> T2) -> T1 -> Prop.
Variable Q1l : (T1 -> T2) -> T3 -> T1 -> Prop.
Variable Q2 : (T1 -> T2) -> T1 -> T1 -> Prop.

Hypothesis sub1 : sub_mem d1 d1'.
Hypothesis sub2 : sub_mem d2 d2'.
Hypothesis sub3 : sub_mem d3 d3'.

Lemma in1W : {all1 P1} -> {in D1, {all1 P1}}.
Proof. by move=> ? ?. Qed.
Lemma in2W : {all2 P2} -> {in D1 & D2, {all2 P2}}.
Proof. by move=> ? ?. Qed.
Lemma in3W : {all3 P3} -> {in D1 & D2 & D3, {all3 P3}}.
Proof. by move=> ? ?. Qed.

Lemma in1A : {in T1, {all1 P1}} -> {all1 P1}.
Proof. by move=> ? ?; auto. Qed.
Lemma in2A : {in T1 & T2, {all2 P2}} -> {all2 P2}.
Proof. by move=> ? ?; auto. Qed.
Lemma in3A : {in T1 & T2 & T3, {all3 P3}} -> {all3 P3}.
Proof. by move=> ? ?; auto. Qed.

Lemma sub_in1 : forall Ph : ph {all1 P1},
  prop_in1 d1' Ph -> prop_in1 d1 Ph.
Proof. move=> ? allP x; move/sub1; exact: allP. Qed.

Lemma sub_in11 : forall Ph : ph {all2 P2},
  prop_in11 d1' d2' Ph -> prop_in11 d1 d2 Ph.
Proof. move=> ? allP x1 x2; move/sub1=> d1x1; move/sub2; exact: allP. Qed.

Lemma sub_in111 :  forall Ph : ph {all3 P3},
  prop_in111 d1' d2' d3' Ph -> prop_in111 d1 d2 d3 Ph.
Proof.
move=> ? allP x1 x2 x3.
move/sub1=> d1x1; move/sub2=> d2x2; move/sub3; exact: allP.
Qed.

Let allQ1 f'' := {all1 Q1 f''}.
Let allQ1l f'' h' := {all1 Q1l f'' h'}.
Let allQ2 f'' := {all2 Q2 f''}.

Lemma on1W : allQ1 f -> {on D2, allQ1 f}. Proof. by move=> ? ?. Qed.

Lemma on1lW : allQ1l f h -> {on D2, allQ1l f & h}. Proof. by move=> ? ?. Qed.

Lemma on2W : allQ2 f -> {on D2 &, allQ2 f}. Proof. by move=> ? ?. Qed.

Lemma on1A : {on T2, allQ1 f} -> allQ1 f. Proof. by move=> ? ?; auto. Qed.

Lemma on1lA : {on T2, allQ1l f & h} -> allQ1l f h.
Proof. by move=> ? ?; auto. Qed.

Lemma on2A : {on T2 &, allQ2 f} -> allQ2 f.
Proof. by move=> ? ?; auto. Qed.

Lemma subon1 : forall (Phf : ph (allQ1 f)) (Ph : ph (allQ1 f)),
  prop_on1 d2' Phf Ph -> prop_on1 d2 Phf Ph.
Proof. move=> ? ? allQ x; move/sub2; exact: allQ. Qed.

Lemma subon1l : forall (Phf : ph (allQ1l f)) (Ph : ph (allQ1l f h)),
  prop_on1 d2' Phf Ph -> prop_on1 d2 Phf Ph.
Proof. move=> ? ? allQ x; move/sub2; exact: allQ. Qed.

Lemma subon2 : forall (Phf : ph (allQ2 f)) (Ph : ph (allQ2 f)),
  prop_on2 d2' Phf Ph -> prop_on2 d2 Phf Ph.
Proof. move=> ? ? allQ x y; move/sub2=> d2fx; move/sub2; exact: allQ. Qed.

Lemma can_in_inj : {in D1, cancel f g} -> {in D1 &, injective f}.
Proof.
by move=> fK x y; do 2![move/fK=> def; rewrite -{2}def {def}] => ->.
Qed.

Lemma on_can_inj : {on D2, cancel f & g} -> {on D2 &, injective f}.
Proof.
by move=> fK x y; do 2![move/fK=> def; rewrite -{2}def {def}] => ->.
Qed.

Lemma inW_bij : bijective f -> {in D1, bijective f}.
Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed.

Lemma onW_bij : bijective f -> {on D2, bijective f}.
Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed.

Lemma inA_bij : {in T1, bijective f} -> bijective f.
Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed.

Lemma onA_bij : {on T2, bijective f} -> bijective f.
Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed.

Lemma sub_in_bij : forall D1' : pred T1,
  {subset D1 <= D1'} -> {in D1', bijective f} -> {in D1, bijective f}.
Proof.
move=> D1' subD [g' fK g'K].
exists g' => x; move/subD; [exact: fK | exact: g'K].
Qed.

Lemma subon_bij :  forall D2' : pred T2,
 {subset D2 <= D2'} -> {on D2', bijective f} -> {on D2, bijective f}.
Proof.
move=> D2' subD [g' fK g'K].
exists g' => x; move/subD; [exact: fK | exact: g'K].
Qed.

End LocalGlobal.

Lemma sub_in2 : forall T d d' (P : T -> T -> Prop),
  sub_mem d d' -> forall Ph : ph {all2 P}, prop_in2 d' Ph -> prop_in2 d Ph.
Proof. by move=> T d d' P /= sub; exact: sub_in11. Qed.

Lemma sub_in3 : forall T d d' (P : T -> T -> T -> Prop),
  sub_mem d d' -> forall Ph : ph {all3 P}, prop_in3 d' Ph -> prop_in3 d Ph.
Proof. by move=> T d d' P /= sub; exact: sub_in111. Qed.

Lemma sub_in12 : forall T1 T d1 d1' d d' (P : T1 -> T -> T -> Prop),
  sub_mem d1 d1' -> sub_mem d d' ->
  forall Ph : ph {all3 P}, prop_in12 d1' d' Ph -> prop_in12 d1 d Ph.
Proof. by move=> T1 T d1 d1' d d' P /= sub1 sub; exact: sub_in111. Qed.

Lemma sub_in21 : forall T T3 d d' d3 d3' (P : T -> T -> T3 -> Prop),
  sub_mem d d' -> sub_mem d3 d3' ->
  forall Ph : ph {all3 P}, prop_in21 d' d3' Ph -> prop_in21 d d3 Ph.
Proof. by move=> T T3 d d' d3 d3' P /= sub sub3; exact: sub_in111. Qed.


(* A collection of auxiliary results about reals. *)
Require Import base.
Require Import Reals.
Require Import micromega.Lra.

Open Scope R_scope.

Lemma neq_2_0 : 2 <> 0. Proof. lra. Qed.
Lemma le_1_2 : 1 <= 2. Proof. lra. Qed.
Lemma le_0_2 : 0 <= 2. Proof. lra. Qed.
Lemma le_0_4 : 0 <= 4. Proof. lra. Qed.
Lemma lt_0_2 : 0 < 2. Proof. lra. Qed.
Lemma eq_2_2_4 : 2 * 2 = 4. Proof. lra. Qed.
Lemma lt_0_4 : 0 < 4. Proof. lra. Qed.
Lemma div_eq_4_2 : 4 / 2 = 2. Proof. lra. Qed.
Lemma div_eq_8_2 : 8 / 2 = 4. Proof. lra. Qed.
Lemma eq_3_1_4 : 3 + 1 = 4. Proof. lra. Qed.
Lemma Rmult_4_2 : 4 * 2 = 8. Proof. lra. Qed.

Lemma Rminus_2_1 : 2 + - (1) = 1. Proof. lra. Qed.

Lemma Rdiv_4_2 : forall n : nat, 4/2^n = 4 * /2^n.
Proof.
  intro n.
  unfold Rdiv.
  reflexivity.
Qed.

Lemma Rdiv_expand : forall n : nat, 1/2^n = 1 * /2^n.
Proof.
  intro n.
  unfold Rdiv.
  reflexivity.
Qed.

Lemma neq_inv_2_0 : 0 <= /2.
Proof.
  apply (Rlt_le 0 (/2)).
  exact (pos_half_prf).
Qed.

Lemma le_eq : forall x y z : R, 0 <= x -> x + y = z -> y <= z.
Proof.
  intros x y z Hx H.
  rewrite <- H.
  rewrite <- (Rplus_0_l y) at 1.
  apply (Rplus_le_compat_r y 0 x Hx).
Qed.

Lemma le_eq_comm : forall x y z : R, 0 <= y -> x + y = z -> x <= z.
Proof.
  intros x y z Hy H.
  rewrite (Rplus_comm x y) in H.
  exact (le_eq y x z Hy H).
Qed.

Lemma Rle_minus_0 : forall x : R, 0 <= x -> - x <= 0.
Proof.
  intros x H.
  apply (le_eq x (- x) 0 H (Rplus_opp_r x)).
Qed.

Lemma Rle_inv_2n : forall n : nat, 0 <= /2^n.
Proof.
  intro n.
  rewrite <- (Rmult_1_l (/2^n)).
  exact (Rle_mult_inv_pos 1 (2^n) Rle_0_1 (pow_lt 2 n Rlt_0_2)).
Qed.

Lemma Rlt_inv_2n : forall n : nat, 0 < /2^n.
Proof.
  intro n.
  rewrite <- (Rmult_1_l (/2^n)).
  exact (Rlt_mult_inv_pos 1 (2^n) Rlt_0_1 (pow_lt 2 n Rlt_0_2)).
Qed.

Lemma pow2 : forall n : R, n^2 = n * n.
Proof.
  intro n.
  simpl.
  rewrite (Rmult_1_r n).
  reflexivity.
Qed.

Lemma sqr_expand : forall a b : R, (a + b)^2 = a^2 + b * (2 * a + b).
Proof.
  exact
    (fun a b =>
      eq_refl ((a + b)^2)
      || _ = (a + b) * X @X by <- Rmult_1_r (a + b)
      || _ = X @X by <- Rmult_plus_distr_r a b (a + b)
      || _ = X + _ @X by <- Rmult_plus_distr_l a a b
      || _ = X + _ + _ @X by pow2 a
      || _ = _ + _ + X @X by <- Rmult_plus_distr_l b a b
      || _ = X @X by <- Rplus_assoc (a^2) (a * b) (b * a + b * b)
      || _ = _ + X @X by Rplus_assoc (a * b) (b * a) (b * b)
      || _ = _ + (_ + X + _) @X by Rmult_comm a b
      || _ = _ + (X + _) @X by double (a * b)
      || _ = _ + (X + _) @X by Rmult_assoc 2 a b
      || _ = _ + X @X by Rmult_plus_distr_r (2 * a) b b
      || _ = _ + X @X by <- Rmult_comm (2 * a + b) b).
Qed.

Lemma eq_2_2n
  : forall n : nat, 2/2^(S n) = 1/2^n.
Proof.
  intro n.
  unfold Rdiv.
  unfold pow.
  fold pow.
  rewrite (Rinv_mult_distr 2 (2^n) neq_2_0 (pow_nonzero 2 n neq_2_0)).
  rewrite <- (Rmult_assoc 2 (/2) (/2^n)).
  rewrite (Rinv_r 2 neq_2_0).
  reflexivity.
Qed.

Lemma eq_1_2n
  : forall n : nat, 1/2^n + 1/2^n = 2/2^n.
Proof.
  intro n.
  unfold Rdiv.
  lra.
Qed.

Lemma le_0_1_2n : forall n : nat, 0 <= 1/2^n.
Proof.
  intro n.
  unfold Rdiv.
  exact (Rle_mult_inv_pos 1 (2^n) ltac:(lra) (pow_lt 2 n Rlt_0_2)).
Qed.

Lemma lt_0_1_2n : forall n : nat, 0 < 1/2^n.
Proof.
  intro n.
  unfold Rdiv.
  exact (Rlt_mult_inv_pos 1 (2^n) ltac:(lra) (pow_lt 2 n Rlt_0_2)).
Qed.

Close Scope R_scope.


Require Import Arith_base.
Require Vectors.Fin.
Import EqNotations.
Local Open Scope nat_scope.

Inductive sortedlist : nat -> Type :=
  | nil : sortedlist 0
  | cons : forall (m n : nat), sortedlist m -> m <= n -> sortedlist n.

Theorem zero_leq_all : forall (m : nat), 0 <= m.
  intros.
  induction m.
    apply le_n.
    apply le_S.
    apply IHm.
Qed.

Theorem zero_leq_1 : 0 <= 1. apply zero_leq_all. Qed.

Definition sortedlist_01 : sortedlist 1 := cons 0 1 nil zero_leq_1.


Require Import Omega.
Goal (221 * 293 * 389 * 397 + 17 = 14 * 119 * 127 * 151 * 313)%nat.
Proof.
  omega.
Qed.


(* Bibliotecas importadas *)

Require Import Arith.

(* Definição indutiva dos termos de L0 *)

Inductive term :=
 | zero   : term
 | succ   : term -> term
 | true   : term
 | false  : term
 | iszero : term -> term
 | pred   : term -> term
 | ifte   : term -> term -> term -> term
.

(* Definição indutiva da propriedade de ser um número *)

Inductive nv : term -> Prop :=
 | zeroNum : nv zero
 | succNum : forall n, (nv n) -> (nv (succ n))
.

(* Definição indutiva de valor : números OU booleanos *)

Inductive value : term -> Prop :=
 | trueVal  : value true
 | falseVal : value false
 | numVal   : forall n, (nv n) -> (value n)
.

(* Testando termos *)
Check ifte false zero (succ zero).

(* Testando valores do tipo termo *)
Check value (iszero true).

(* Provando uma propriedade *)
Theorem teste1 : value (succ zero).
Proof.
constructor 3.
constructor 2.
constructor 1.
Qed.

(* Provando uma propriedade 2 *)
Theorem teste2 : value (succ zero).
Proof.
apply numVal.
apply succNum.
apply zeroNum.
Qed.

(* Provando uma propriedade negada *)
Lemma teste : ~ value (iszero true).
Proof.
unfold not.
intro H.
inversion H.
subst.
inversion H0.
Qed.

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

(* Definição da semântica operacional *)
Inductive step : term -> term -> Prop :=
 | e_iftrue     : forall t2 t3,        step (ifte true  t2 t3) t2
 | e_iffalse    : forall t2 t3,        step (ifte false t2 t3) t3
 | e_if         : forall t1 t2 t3 t1', (step t1 t1') -> step (ifte t1 t2 t3) (ifte t1' t2 t3)
 | e_succ       : forall t t',         step t t' -> step (succ t) (succ t')
 | e_predzero   :                      step (pred zero) zero
 | e_predsucc   : forall t,  (nv t) -> step (pred (succ t)) t
 | e_pred       : forall t t',         step t t' -> step (pred t) (pred t')
 | e_iszerozero :                      step (iszero zero) true
 | e_iszerosucc : forall t,  (nv t) -> step (iszero (succ t)) false
 | e_iszero     : forall t t',         step t t' -> step (iszero t) (iszero t')
.

(* Definição de forma normal *)

Definition NF (t:term) : Prop := forall t', not (step t t').

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

(* Exercício : TODO NV É FORMA NORMAL *)
Theorem nvNF : forall (t:term), nv t -> NF t.
Proof.
induction t.
intro. unfold NF. intro. unfold not. intro. inversion H0. (* zero *)
intro. inversion H. subst. apply IHt in H1. unfold NF in H1.  intro. unfold not. intro. inversion H0. subst. unfold not in H1. apply (H1 t'0) in H3. assumption. (* succ *)
intro. unfold NF. intro. intro. inversion H0. (* true *)
intro. unfold NF. intro. intro. inversion H0. (* false *)
intro. inversion H. (* iszero *)
intro. inversion H. (* pred *)
intro. inversion H. (* ifte *)
Qed.

(* Exercício : TODO VALOR É FORMA NORMAL *)

Theorem valueNF : forall (t:term), value t -> NF t.
Proof.
intro.
intro.
induction H.
  (* H=true *)
  unfold NF.
  intro.
  unfold not.
  intro.
  inversion H.
  (* H=false *)
  unfold NF.
  intro.
  unfold not.
  intro.
  inversion H.
  (* H=nv *)
  apply nvNF.
  assumption.
Qed.

(* DETERMINISMO *)

Theorem determinismo : forall t t' t'', (step t t') -> (step t t'') -> (t' = t'').
Proof.
induction t.
(* zero *)
intros. inversion H.
(* succ *)
intros.  inversion H. inversion H0. subst. assert (t'0 = t'1). apply (IHt t'0 t'1 H2 H5). apply f_equal. assumption.
(* true *)
intros. inversion H.
(* false *)
intros. inversion H.
(* iszero *)

intros. inversion H. subst. inversion H0. reflexivity. inversion H2.
inversion H0.  subst. discriminate H5. reflexivity. subst.
apply succNum in H2. apply nvNF in H2. unfold NF in H2. unfold not in H2. apply H2 in H5. exfalso. assumption.
inversion H0.  subst.  inversion H2. subst. apply succNum in H5. apply nvNF in H5. unfold NF in H5. unfold not in H5. exfalso. apply (H5 t'0 H2). subst. apply f_equal. apply (IHt t'0 t'1 H2 H5).

intros. inversion H. subst. inversion H0. reflexivity. inversion H2.
inversion H0.  subst. discriminate H5. subst. injection H4. intro. symmetry.  assumption.
subst.
apply succNum in H2. apply nvNF in H2. unfold NF in H2. unfold not in H2. apply H2 in H5. exfalso. assumption.
inversion H0.  subst.  inversion H2. subst. apply succNum in H5. apply nvNF in H5. unfold NF in H5. unfold not in H5. exfalso. apply (H5 t'0 H2). subst. apply f_equal. apply (IHt t'0 t'1 H2 H5).

intros.
inversion H. subst. inversion H0. subst. reflexivity. inversion H5.

inversion H0. subst. discriminate. subst. assumption. subst. inversion H9. subst. inversion H0. subst. inversion H5. subst. inversion H5. subst. assert (t1'=t1'0). apply IHt1. assumption. assumption. rewrite H1. reflexivity.

Qed.

Inductive type :=
  | tNat : type
  | tBool : type.

Inductive hasType : term -> type -> Prop :=
  | tTrue : hasType true tBool
  | tFalse : hasType false tBool
  | tZero : hasType zero tNat
  | tSucc : forall t1, hasType t1 tNat -> hasType (succ t1) tNat
  | tPred : forall t1, hasType t1 tNat -> hasType (pred t1) tNat
  | tIsZero: forall t1, hasType t1 tNat -> hasType (iszero t1) tBool
  | tIf: forall t1 t2 t3 T, hasType t1 tBool -> hasType t2 T -> hasType t3 T -> hasType (ifte t1 t2 t3) T.

Theorem two_a : hasType (ifte ((iszero (succ (succ zero)))) (succ zero) zero) tNat.
Proof.
apply tIf.
apply tIsZero.
apply tSucc. apply tSucc. apply tZero.
apply tSucc. apply tZero.
apply tZero.
Qed.

Theorem two_b: step (ifte (iszero (succ (succ zero))) (succ zero) zero) (ifte false (succ zero) zero).
Proof.
apply e_if.
apply e_iszerosucc. apply succNum. apply zeroNum.
Qed.

Theorem two_c: ~ step (ifte (iszero (succ (succ zero))) (succ zero) zero) zero.
Proof.
unfold not.
intros.
inversion H.
Qed.

Theorem two_d:  ~ forall (t : term) , value t.
Proof.
unfold not.
intro.
assert (value (iszero zero)).
apply (H (iszero zero)).
inversion H0.
inversion H1.
Qed.

Theorem two_e:  forall (t : term), (value t \/ ~value t).
Proof.
induction t.
  left. apply numVal. apply zeroNum.
  induction IHt.
    induction H.
      right. unfold not. intros. inversion H. subst. inversion H0. subst. inversion H2.
      right. unfold not. intros. inversion H. subst. inversion H0. subst. inversion H2.
      left. apply numVal. apply succNum. assumption.
      right. intro. apply H. apply numVal. inversion H0. inversion H1. subst. assumption.
  left. apply trueVal.
  left. apply falseVal.
  right. unfold not. intros. inversion H. subst. inversion H0.
  right. unfold not. intros. inversion H. subst. inversion H0.
  right. unfold not. intros. inversion H. subst. inversion H0.
(* martelado *)
Qed.

Theorem unicidade: forall (t : term) (T : type) , (hasType t T) -> forall T', (hasType t T') -> T=T'.
Proof.
induction t.
  intros. inversion H. subst. inversion H0. reflexivity.
  intros. inversion H. subst. inversion H0. reflexivity.
  intros. inversion H. subst. inversion H0. reflexivity.
  intros. inversion H. subst. inversion H0. reflexivity.
  intros. inversion H. subst. inversion H0. reflexivity.
  intros. inversion H. subst. inversion H0. reflexivity.
  intros. inversion H. subst. apply IHt2. assumption.
    inversion H0. subst. assumption.
Qed.

Theorem preservacao:  forall t t', step t t' -> forall T, hasType t T -> hasType t' T.
Proof.
induction t.
  intros. inversion H0. subst. inversion H.
  intros. inversion H0. subst. apply e_succ in H.
(* proof by cansaço *)
Admitted.


Require Import Arith.
Require Import ZArith.
Require Import Bool.
Require Import List.
Open Scope Z_scope.

Inductive sorted : list Z -> Prop :=
 | sortedzer : sorted nil
 | sortedone : forall x : Z, sorted ( x :: nil )
 | sortedres : forall ( x y : Z ) ( l : list Z ) ,
                  x <= y -> sorted ( y :: l ) -> sorted ( x :: y :: l ).

Theorem sorted_inv : forall ( z : Z ) ( l : list Z ),
                       sorted ( z :: l ) -> sorted l.
Proof.
  intros z l H. inversion H. apply sortedzer. auto.
Qed.

Print  Z_le_gt_dec.
Fixpoint aux ( n : Z ) ( l : list Z ) : list Z :=
  match l with
    | nil => n :: nil
    | ( p :: l' ) => if Z_le_gt_dec n p then p :: ( aux n l' )
                     else n :: p :: l'
  end.

Theorem aux_equiv :
  forall ( x : Z ) ( l : list Z ), aux x l = x :: l.
Proof.
  intros x l. unfold aux. Admitted.

Theorem imp_trans :
  forall ( P Q R : Prop ), ( P -> Q ) -> ( Q -> R ) -> P -> R.
Proof.
  intros P Q R H1 H2 p. apply H2. apply H1. apply p.
Qed.

Lemma weak_peirce :
  forall ( P Q : Prop ), (((( P -> Q ) -> P ) -> P ) -> Q ) -> Q.
Proof.
  intros P Q H. apply H. intros H1. apply H1. intros H2.
  apply H. intros H3. apply H2.
Qed.

Check le 3 4.
Check and.
Check fst.
Check ( forall ( P : Prop ), P -> P ).
Check ( true = false ).
Check list Prop.
Open Scope nat_scope.
Definition lt ( n p : nat ) : Prop := S n <= p.

Theorem conv_example :
  forall n : nat , 7 * 5 < n -> 6 * 6 <= n.
Proof.
  intros n H. assumption.
Qed.

Print conv_example.
Check ( imp_trans _ _ _ ( le_S 0 1 ) ( le_S 0 2 ) ).

Definition neutral_left ( A : Set ) ( op : A -> A -> A ) ( e : A ) : Prop :=
  forall x : A, op e x = x.

Theorem one_neutral_left : neutral_left Z Zmult 1%Z.
Proof.
  unfold neutral_left. intros x. omega.
Qed.

Theorem all_imp_dist :
  forall ( A : Type ) ( P Q : A -> Type ),
    (forall x : A, P x -> Q x ) -> ( forall y : A , P y ) -> forall z : A , Q z.
Proof.
  intros A P Q H1 H2 z.
  apply H1. apply H2.
Qed.

Theorem le_mult_mult:
  forall a b c d : nat, a <= c -> b <= d -> a * b <= c * d.
Proof.
  intros a b c d H1 H2.
  apply le_trans with ( m := c * b ).
  Search ( _ <= _ -> _ * _ <= _ * _ ).
  apply mult_le_compat_r. assumption.
  apply mult_le_compat_l. assumption.
Qed.

Theorem le_mult_mult' :
  forall a b c d : nat, a <= c -> b <= d -> a * b <= c * d.
Proof.
  intros a b c d H1 H2.
  eapply le_trans.
  eapply mult_le_compat_l. eexact H2.
  apply mult_le_compat_r. assumption.
Qed.

Theorem lt_S :
  forall n p : nat, n < p -> n < S p.
Proof.
  intros n p H. apply le_S. trivial.
Qed.

Definition opaque_f : nat -> nat -> nat.
  intros. assumption.
Qed.

Print opaque_f.
Open Scope Z_scope.

Definition Zsquare_diff ( x y : Z ) : Z := (x * x - y * y).
Theorem unfold_example:
  forall x y : Z, x * x = y * y  ->
                  ( Zsquare_diff x y )%Z * Zsquare_diff ( x + y ) ( x + y ) = 0.
Proof.
  intros x y H. unfold Zsquare_diff at 1. rewrite -> H.
  SearchAbout ( _ * _ - _ * _ ).
Admitted.

Section ex_falso_quodlibet.
  Hypothesis ff : False.
  Lemma ex1 : 220 = 284.
  Proof.
    apply False_ind. exact ff.
  Qed.
  Lemma ex2 : 220 = 284.
  Proof.
    elim ff.
  Qed.
End ex_falso_quodlibet.

Print ex2.
Theorem absurd : forall P Q : Prop, P -> ~P -> Q.
Proof.
  intros P Q p H. elim H. assumption.
Qed.

Theorem double_neg_i :
  forall P : Prop, P -> ~~P.
Proof.
  intros P p H. elim H. assumption.
Qed.

Theorem modus_ponens :
  forall P Q : Prop, P -> ( P -> Q ) -> Q.
Proof.
  intros P Q p H. apply H. assumption.
Qed.

Theorem double_neg_i' :
  forall P : Prop, P -> ~~P.
Proof.
  intros P. Proof ( modus_ponens P False ).

Theorem contrap :
     forall A B : Prop, ( A -> B ) -> ( ~B -> ~A ).
Proof.
  intros A B. unfold not.
  intros H1 H2 a. apply H2. apply H1. assumption.
Qed.

Theorem not_false : ~False.
Proof.
  unfold not. intros H. assumption.
Qed.

Theorem not_not_not_p :
  forall P Q : Prop, ~~~P -> P -> Q.
Proof.
  intros P Q. unfold not. intros H p. elim H.
  intros H1. apply H1. assumption.
Qed.

Theorem ex_imp_ex :
  forall ( A : Type ) ( P Q : A -> Prop ),
    ( ex P ) -> ( forall x : A, P x -> Q x ) -> ex Q.
Proof.
  intros A P Q H1 H2.
  inversion H1. exists x.
  apply H2. assumption.
Qed.

Theorem ex_PQ :
  forall ( A : Set ) ( P Q : A -> Prop ),
    ( exists  x : A, ( P x \/ Q x )) ->  ( ex P ) \/ ( ex Q ).
Proof.
  intros A P Q H.
  inversion H. inversion H0 as [ HP | HQ ].
  left. exists x. assumption.
  right. exists x. assumption.
Qed.

Theorem diff_square :
  forall a b : Z,
    ( a + b ) * ( a - b ) = a * a - b * b .
Proof.
  intros a b.
  Require Import ZArithRing.
  ring.
Qed.

(*
Definition my_true : Prop :=
  forall P : Prop, P -> P.
Definition my_false : Prop :=
  forall P : Prop, P.
Theorem my_I : my_true.
proof.
  unfold my_true. intros P p. assumption.
*)

Section inject_example.
  Variables A B : Set.
  Inductive T : Set :=
  | cone : A -> T
  | ctwo : B -> T.
  Theorem inject_ctwo :
    forall x y : B, ctwo x = ctwo y -> x = y.
  Proof.
    intros x y H.
    change ( let phi :=  fun ( v : T ) =>
      match v with
       | cone _ => x
       | ctwo v' => v'
      end in phi ( ctwo x ) = phi ( ctwo y )).
    rewrite H. reflexivity.
  Qed.
End inject_example.

Print nat_ind.

Variable div_pair :
  forall a b : Z, 0 < b ->
                  { p : Z * Z | a = ( fst p ) * b + snd p /\ 0 <= snd p < b}.

Eval compute in div_pair 4 5.

Definition pred' :
  forall n : nat, { p : nat | n = S p }+{ n = O }.
  intros n. case n.
  right. apply refl_equal.
  intros p.left. exists p. reflexivity.
Defined.