(* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *)
Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq fintype.
Require Import finfun paths ssralg.
(*Require Import div connect.*)

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

Reserved Notation "\big [ op / nil ]_ i F"
  (at level 36, F at level 36, op, nil at level 10, i at level 0,
     right associativity,
           format "'[' \big [ op / nil ]_ i '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( <- r | P ) F"
  (at level 36, F at level 36, op, nil at level 10, r at level 50,
           format "'[' \big [ op / nil ]_ ( <-  r  |  P ) '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( i <- r | P ) F"
  (at level 36, F at level 36, op, nil at level 10, i, r at level 50,
           format "'[' \big [ op / nil ]_ ( i  <-  r  |  P ) '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( i <- r ) F"
  (at level 36, F at level 36, op, nil at level 10, i, r at level 50,
           format "'[' \big [ op / nil ]_ ( i  <-  r ) '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( m <= i < n | P ) F"
  (at level 36, F at level 36, op, nil at level 10, m, i, n at level 50,
           format "'[' \big [ op / nil ]_ ( m  <=  i  <  n  |  P )  F ']'").
Reserved Notation "\big [ op / nil ]_ ( m <= i < n ) F"
  (at level 36, F at level 36, op, nil at level 10, i, m, n at level 50,
           format "'[' \big [ op / nil ]_ ( m  <=  i  <  n ) '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( i | P ) F"
  (at level 36, F at level 36, op, nil at level 10, i at level 50,
           format "'[' \big [ op / nil ]_ ( i  |  P ) '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( i : t | P ) F"
  (at level 36, F at level 36, op, nil at level 10, i at level 50,
           format "'[' \big [ op / nil ]_ ( i   :  t   |  P ) '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( i : t ) F"
  (at level 36, F at level 36, op, nil at level 10, i at level 50,
           format "'[' \big [ op / nil ]_ ( i   :  t ) '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( i < n | P ) F"
  (at level 36, F at level 36, op, nil at level 10, i, n at level 50,
           format "'[' \big [ op / nil ]_ ( i  <  n  |  P ) '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( i < n ) F"
  (at level 36, F at level 36, op, nil at level 10, i, n at level 50,
           format "'[' \big [ op / nil ]_ ( i  <  n )  F ']'").
Reserved Notation "\big [ op / nil ]_ ( i \in A | P ) F"
  (at level 36, F at level 36, op, nil at level 10, i, A at level 50,
           format "'[' \big [ op / nil ]_ ( i  \in  A  |  P ) '/  '  F ']'").
Reserved Notation "\big [ op / nil ]_ ( i \in A ) F"
  (at level 36, F at level 36, op, nil at level 10, i, A at level 50,
           format "'[' \big [ op / nil ]_ ( i  \in  A ) '/  '  F ']'").

Reserved Notation "\sum_ i F"
  (at level 41, F at level 41, i at level 0,
           right associativity,
           format "'[' \sum_ i '/  '  F ']'").
Reserved Notation "\sum_ ( <- r | P ) F"
  (at level 41, F at level 41, r at level 50,
           format "'[' \sum_ ( <-  r  |  P ) '/  '  F ']'").
Reserved Notation "\sum_ ( i <- r | P ) F"
  (at level 41, F at level 41, i, r at level 50,
           format "'[' \sum_ ( i  <-  r  |  P ) '/  '  F ']'").
Reserved Notation "\sum_ ( i <- r ) F"
  (at level 41, F at level 41, i, r at level 50,
           format "'[' \sum_ ( i  <-  r ) '/  '  F ']'").
Reserved Notation "\sum_ ( m <= i < n | P ) F"
  (at level 41, F at level 41, i, m, n at level 50,
           format "'[' \sum_ ( m  <=  i  <  n  |  P ) '/  '  F ']'").
Reserved Notation "\sum_ ( m <= i < n ) F"
  (at level 41, F at level 41, i, m, n at level 50,
           format "'[' \sum_ ( m  <=  i  <  n ) '/  '  F ']'").
Reserved Notation "\sum_ ( i | P ) F"
  (at level 41, F at level 41, i at level 50,
           format "'[' \sum_ ( i  |  P ) '/  '  F ']'").
Reserved Notation "\sum_ ( i : t | P ) F"
  (at level 41, F at level 41, i at level 50,
           only parsing).
Reserved Notation "\sum_ ( i : t ) F"
  (at level 41, F at level 41, i at level 50,
           only parsing).
Reserved Notation "\sum_ ( i < n | P ) F"
  (at level 41, F at level 41, i, n at level 50,
           format "'[' \sum_ ( i  <  n  |  P ) '/  '  F ']'").
Reserved Notation "\sum_ ( i < n ) F"
  (at level 41, F at level 41, i, n at level 50,
           format "'[' \sum_ ( i  <  n ) '/  '  F ']'").
Reserved Notation "\sum_ ( i \in A | P ) F"
  (at level 41, F at level 41, i, A at level 50,
           format "'[' \sum_ ( i  \in  A  |  P ) '/  '  F ']'").
Reserved Notation "\sum_ ( i \in A ) F"
  (at level 41, F at level 41, i, A at level 50,
           format "'[' \sum_ ( i  \in  A ) '/  '  F ']'").

Reserved Notation "\max_ i F"
  (at level 41, F at level 41, i at level 0,
           format "'[' \max_ i '/  '  F ']'").
Reserved Notation "\max_ ( <- r | P ) F"
  (at level 41, F at level 41, r at level 50,
           format "'[' \max_ ( <-  r  |  P ) '/  '  F ']'").
Reserved Notation "\max_ ( i <- r | P ) F"
  (at level 41, F at level 41, i, r at level 50,
           format "'[' \max_ ( i  <-  r  |  P ) '/  '  F ']'").
Reserved Notation "\max_ ( i <- r ) F"
  (at level 41, F at level 41, i, r at level 50,
           format "'[' \max_ ( i  <-  r ) '/  '  F ']'").
Reserved Notation "\max_ ( m <= i < n | P ) F"
  (at level 41, F at level 41, i, m, n at level 50,
           format "'[' \max_ ( m  <=  i  <  n  |  P ) '/  '  F ']'").
Reserved Notation "\max_ ( m <= i < n ) F"
  (at level 41, F at level 41, i, m, n at level 50,
           format "'[' \max_ ( m  <=  i  <  n ) '/  '  F ']'").
Reserved Notation "\max_ ( i | P ) F"
  (at level 41, F at level 41, i at level 50,
           format "'[' \max_ ( i  |  P ) '/  '  F ']'").
Reserved Notation "\max_ ( i : t | P ) F"
  (at level 41, F at level 41, i at level 50,
           only parsing).
Reserved Notation "\max_ ( i : t ) F"
  (at level 41, F at level 41, i at level 50,
           only parsing).
Reserved Notation "\max_ ( i < n | P ) F"
  (at level 41, F at level 41, i, n at level 50,
           format "'[' \max_ ( i  <  n  |  P ) '/  '  F ']'").
Reserved Notation "\max_ ( i < n ) F"
  (at level 41, F at level 41, i, n at level 50,
           format "'[' \max_ ( i  <  n )  F ']'").
Reserved Notation "\max_ ( i \in A | P ) F"
  (at level 41, F at level 41, i, A at level 50,
           format "'[' \max_ ( i  \in  A  |  P ) '/  '  F ']'").
Reserved Notation "\max_ ( i \in A ) F"
  (at level 41, F at level 41, i, A at level 50,
           format "'[' \max_ ( i  \in  A ) '/  '  F ']'").

Reserved Notation "\prod_ i F"
  (at level 36, F at level 36, i at level 0,
           format "'[' \prod_ i '/  '  F ']'").
Reserved Notation "\prod_ ( <- r | P ) F"
  (at level 36, F at level 36, r at level 50,
           format "'[' \prod_ ( <-  r  |  P ) '/  '  F ']'").
Reserved Notation "\prod_ ( i <- r | P ) F"
  (at level 36, F at level 36, i, r at level 50,
           format "'[' \prod_ ( i  <-  r  |  P ) '/  '  F ']'").
Reserved Notation "\prod_ ( i <- r ) F"
  (at level 36, F at level 36, i, r at level 50,
           format "'[' \prod_ ( i  <-  r ) '/  '  F ']'").
Reserved Notation "\prod_ ( m <= i < n | P ) F"
  (at level 36, F at level 36, i, m, n at level 50,
           format "'[' \prod_ ( m  <=  i  <  n  |  P ) '/  '  F ']'").
Reserved Notation "\prod_ ( m <= i < n ) F"
  (at level 36, F at level 36, i, m, n at level 50,
           format "'[' \prod_ ( m  <=  i  <  n ) '/  '  F ']'").
Reserved Notation "\prod_ ( i | P ) F"
  (at level 36, F at level 36, i at level 50,
           format "'[' \prod_ ( i  |  P ) '/  '  F ']'").
Reserved Notation "\prod_ ( i : t | P ) F"
  (at level 36, F at level 36, i at level 50,
           only parsing).
Reserved Notation "\prod_ ( i : t ) F"
  (at level 36, F at level 36, i at level 50,
           only parsing).
Reserved Notation "\prod_ ( i < n | P ) F"
  (at level 36, F at level 36, i, n at level 50,
           format "'[' \prod_ ( i  <  n  |  P ) '/  '  F ']'").
Reserved Notation "\prod_ ( i < n ) F"
  (at level 36, F at level 36, i, n at level 50,
           format "'[' \prod_ ( i  <  n ) '/  '  F ']'").
Reserved Notation "\prod_ ( i \in A | P ) F"
  (at level 36, F at level 36, i, A at level 50,
           format "'[' \prod_ ( i  \in  A  |  P )  F ']'").
Reserved Notation "\prod_ ( i \in A ) F"
  (at level 36, F at level 36, i, A at level 50,
           format "'[' \prod_ ( i  \in  A ) '/  '  F ']'").

Delimit Scope big_scope with BIG.
Open Scope big_scope.

Definition reducebig R I nil op r (P : pred I) (F : I -> R) : R :=
  foldr (fun i x => if P i then op (F i) x else x) nil r.

Module Type ReduceBigSig.
Parameter bigop : forall R I,
   R -> (R -> R -> R) -> seq I -> pred I -> (I -> R) -> R.
Axiom bigopE : bigop = reducebig.
End ReduceBigSig.

Module ReduceBig : ReduceBigSig.
Definition bigop := reducebig.
Lemma bigopE : bigop = reducebig. Proof. by []. Qed.
End ReduceBig.

Notation bigop := ReduceBig.bigop.
Canonical Structure reduce_big_unlock := Unlockable ReduceBig.bigopE.

Definition index_iota m n := iota m (n - m).

Definition index_enum (T : finType) := enum T.

Lemma mem_index_iota : forall m n i, i \in index_iota m n = (m <= i < n).
Proof.
move=> m n i; rewrite mem_iota; case le_m_i: (m <= i) => //=.
by rewrite -leq_sub_add leq_subS // -ltn_0sub subn_sub subnK // ltn_0sub.
Qed.

Lemma filter_index_enum : forall T P, filter P (index_enum T) = enum P.
Proof. by move=> T P; rewrite /enum -enumE. Qed.

Notation "\big [ op / nil ]_ ( <- r | P ) F" :=
  (bigop nil op r P F) : big_scope.
Notation "\big [ op / nil ]_ ( i <- r | P ) F" :=
  (bigop nil op r (fun i => P%B) (fun i => F)) : big_scope.
Notation "\big [ op / nil ]_ ( i <- r ) F" :=
  (bigop nil op r (fun _ => true) (fun  i => F)) : big_scope.
Notation "\big [ op / nil ]_ ( m <= i < n | P ) F" :=
  (bigop nil op (index_iota m n) (fun i : nat => P%B) (fun i : nat => F))
     : big_scope.
Notation "\big [ op / nil ]_ ( m <= i < n ) F" :=
  (bigop nil op (index_iota m n) (fun _ => true) (fun i : nat => F))
     : big_scope.
Notation "\big [ op / nil ]_ ( i | P ) F" :=
  (bigop nil op (index_enum _) (fun i => P%B) (fun i => F)) : big_scope.
Notation "\big [ op / nil ]_ i F" :=
  (bigop nil op (index_enum _) (fun _ => true) (fun i => F)) : big_scope.
Notation "\big [ op / nil ]_ ( i : t | P ) F" :=
  (bigop nil op (index_enum _) (fun i : t => P%B) (fun i : t => F))
     (only parsing) : big_scope.
Notation "\big [ op / nil ]_ ( i : t ) F" :=
  (bigop nil op (index_enum _) (fun _ => true) (fun i : t => F))
     (only parsing) : big_scope.
Notation "\big [ op / nil ]_ ( i < n | P ) F" :=
  (\big[op/nil]_(i : ordinal n | P%B) F) : big_scope.
Notation "\big [ op / nil ]_ ( i < n ) F" :=
  (\big[op/nil]_(i : ordinal n) F) : big_scope.
Notation "\big [ op / nil ]_ ( i \in A | P ) F" :=
  (\big[op/nil]_(i | (i \in A) && P) F) : big_scope.
Notation "\big [ op / nil ]_ ( i \in A ) F" :=
  (\big[op/nil]_(i | i \in A) F) : big_scope.

Notation Local "'+%R'" := (@Ring.add _) (at level 0).
Notation Local "'+%N'" := addn (at level 0, only parsing).

Notation "\sum_ ( <- r | P ) F" :=
  (\big[+%R/0%R]_(<- r | P%B) F%R) : ring_scope.
Notation "\sum_ ( i <- r | P ) F" :=
  (\big[+%R/0%R]_(i <- r | P%B) F%R) : ring_scope.
Notation "\sum_ ( i <- r ) F" :=
  (\big[+%R/0%R]_(i <- r) F%R) : ring_scope.
Notation "\sum_ ( m <= i < n | P ) F" :=
  (\big[+%R/0%R]_(m <= i < n | P%B) F%R) : ring_scope.
Notation "\sum_ ( m <= i < n ) F" :=
  (\big[+%R/0%R]_(m <= i < n) F%R) : ring_scope.
Notation "\sum_ ( i | P ) F" :=
  (\big[+%R/0%R]_(i | P%B) F%R) : ring_scope.
Notation "\sum_ i F" :=
  (\big[+%R/0%R]_i F%R) : ring_scope.
Notation "\sum_ ( i : t | P ) F" :=
  (\big[+%R/0%R]_(i : t | P%B) F%R) (only parsing) : ring_scope.
Notation "\sum_ ( i : t ) F" :=
  (\big[+%R/0%R]_(i : t) F%R) (only parsing) : ring_scope.
Notation "\sum_ ( i < n | P ) F" :=
  (\big[+%R/0%R]_(i < n | P%B) F%R) : ring_scope.
Notation "\sum_ ( i < n ) F" :=
  (\big[+%R/0%R]_(i < n) F%R) : ring_scope.
Notation "\sum_ ( i \in A | P ) F" :=
  (\big[+%R/0%R]_(i \in A | P%B) F%R) : ring_scope.
Notation "\sum_ ( i \in A ) F" :=
  (\big[+%R/0%R]_(i \in A) F%R) : ring_scope.

Notation "\sum_ ( <- r | P ) F" :=
  (\big[+%N/0%N]_(<- r | P%B) F%N) : nat_scope.
Notation "\sum_ ( i <- r | P ) F" :=
  (\big[+%N/0%N]_(i <- r | P%B) F%N) : nat_scope.
Notation "\sum_ ( i <- r ) F" :=
  (\big[+%N/0%N]_(i <- r) F%N) : nat_scope.
Notation "\sum_ ( m <= i < n | P ) F" :=
  (\big[+%N/0%N]_(m <= i < n | P%B) F%N) : nat_scope.
Notation "\sum_ ( m <= i < n ) F" :=
  (\big[+%N/0%N]_(m <= i < n) F%N) : nat_scope.
Notation "\sum_ ( i | P ) F" :=
  (\big[+%N/0%N]_(i | P%B) F%N) : nat_scope.
Notation "\sum_ i F" :=
  (\big[+%N/0%N]_i F%N) : nat_scope.
Notation "\sum_ ( i : t | P ) F" :=
  (\big[+%N/0%N]_(i : t | P%B) F%N) (only parsing) : nat_scope.
Notation "\sum_ ( i : t ) F" :=
  (\big[+%N/0%N]_(i : t) F%N) (only parsing) : nat_scope.
Notation "\sum_ ( i < n | P ) F" :=
  (\big[+%N/0%N]_(i < n | P%B) F%N) : nat_scope.
Notation "\sum_ ( i < n ) F" :=
  (\big[+%N/0%N]_(i < n) F%N) : nat_scope.
Notation "\sum_ ( i \in A | P ) F" :=
  (\big[+%N/0%N]_(i \in A | P%B) F%N) : nat_scope.
Notation "\sum_ ( i \in A ) F" :=
  (\big[+%N/0%N]_(i \in A) F%N) : nat_scope.

Notation Local "'*%R'" := (@Ring.mul _) (at level 0).
Notation Local "'*%N'" := muln (at level 0, only parsing).

Notation "\prod_ ( <- r | P ) F" :=
  (\big[*%R/1%R]_(<- r | P%B) F%R) : ring_scope.
Notation "\prod_ ( i <- r | P ) F" :=
  (\big[*%R/1%R]_(i <- r | P%B) F%R) : ring_scope.
Notation "\prod_ ( i <- r ) F" :=
  (\big[*%R/1%R]_(i <- r) F%R) : ring_scope.
Notation "\prod_ ( m <= i < n | P ) F" :=
  (\big[*%R/1%R]_(m <= i < n | P%B) F%R) : ring_scope.
Notation "\prod_ ( m <= i < n ) F" :=
  (\big[*%R/1%R]_(m <= i < n) F%R) : ring_scope.
Notation "\prod_ ( i | P ) F" :=
  (\big[*%R/1%R]_(i | P%B) F%R) : ring_scope.
Notation "\prod_ i F" :=
  (\big[*%R/1%R]_i F%R) : ring_scope.
Notation "\prod_ ( i : t | P ) F" :=
  (\big[*%R/1%R]_(i : t | P%B) F%R) (only parsing) : ring_scope.
Notation "\prod_ ( i : t ) F" :=
  (\big[*%R/1%R]_(i : t) F%R) (only parsing) : ring_scope.
Notation "\prod_ ( i < n | P ) F" :=
  (\big[*%R/1%R]_(i < n | P%B) F%R) : ring_scope.
Notation "\prod_ ( i < n ) F" :=
  (\big[*%R/1%R]_(i < n) F%R) : ring_scope.
Notation "\prod_ ( i \in A | P ) F" :=
  (\big[*%R/1%R]_(i \in A | P%B) F%R) : ring_scope.
Notation "\prod_ ( i \in A ) F" :=
  (\big[*%R/1%R]_(i \in A) F%R) : ring_scope.

Notation "\prod_ ( <- r | P ) F" :=
  (\big[*%N/1%N]_(<- r | P%B) F%N) : nat_scope.
Notation "\prod_ ( i <- r | P ) F" :=
  (\big[*%N/1%N]_(i <- r | P%B) F%N) : nat_scope.
Notation "\prod_ ( i <- r ) F" :=
  (\big[*%N/1%N]_(i <- r) F%N) : nat_scope.
Notation "\prod_ ( m <= i < n | P ) F" :=
  (\big[*%N/1%N]_(m <= i < n | P%B) F%N) : nat_scope.
Notation "\prod_ ( m <= i < n ) F" :=
  (\big[*%N/1%N]_(m <= i < n) F%N) : nat_scope.
Notation "\prod_ ( i | P ) F" :=
  (\big[*%N/1%N]_(i | P%B) F%N) : nat_scope.
Notation "\prod_ i F" :=
  (\big[*%N/1%N]_i F%N) : nat_scope.
Notation "\prod_ ( i : t | P ) F" :=
  (\big[*%N/1%N]_(i : t | P%B) F%N) (only parsing) : nat_scope.
Notation "\prod_ ( i : t ) F" :=
  (\big[*%N/1%N]_(i : t) F%N) (only parsing) : nat_scope.
Notation "\prod_ ( i < n | P ) F" :=
  (\big[*%N/1%N]_(i < n | P%B) F%N) : nat_scope.
Notation "\prod_ ( i < n ) F" :=
  (\big[*%N/1%N]_(i < n) F%N) : nat_scope.
Notation "\prod_ ( i \in A | P ) F" :=
  (\big[*%N/1%N]_(i \in A | P%B) F%N) : nat_scope.
Notation "\prod_ ( i \in A ) F" :=
  (\big[*%N/1%N]_(i \in A) F%N) : nat_scope.

Section Extensionality.

Variables (R : Type)  (nil : R) (op : R -> R -> R).

Section SeqExtension.

Variable I : Type.

Lemma big_filter : forall r (P : pred I) F,
  \big[op/nil]_(i <- filter P r) F i = \big[op/nil]_(i <- r | P i) F i.
Proof. by rewrite unlock => r P F; elim: r => //= i r <-; case (P i). Qed.

Lemma big_filter_cond : forall r (P1 P2 : pred I) F,
  \big[op/nil]_(i <- filter P1 r | P2 i) F i
     = \big[op/nil]_(i <- r | P1 i && P2 i) F i.
Proof.
move=> r P1 P2 F; rewrite -big_filter -(big_filter r); congr bigop.
rewrite -filter_predI; apply: eq_filter => i; exact: andbC.
Qed.

Lemma eq_bigl : forall r (P1 P2 : pred I) F, P1 =1 P2 ->
  \big[op/nil]_(i <- r | P1 i) F i = \big[op/nil]_(i <- r | P2 i) F i.
Proof.
by move=> r P1 P2 F eqP12; rewrite -big_filter (eq_filter eqP12) big_filter.
Qed.

Lemma eq_bigr : forall r (P : pred I) F1 F2, (forall i, P i -> F1 i = F2 i) ->
  \big[op/nil]_(i <- r | P i) F1 i = \big[op/nil]_(i <- r | P i) F2 i.
Proof.
move=> r P F1 F2 eqF12; rewrite unlock.
by elim: r => //= x r ->; case Px: (P x); rewrite // eqF12.
Qed.

Lemma eq_big : forall r (P1 P2 : pred I) F1 F2,
  P1 =1 P2 -> (forall i, P1 i -> F1 i = F2 i) ->
  \big[op/nil]_(i <- r | P1 i) F1 i = \big[op/nil]_(i <- r | P2 i) F2 i.
Proof. by move=> r P1 P2 F1 F2; move/eq_bigl <-; move/eq_bigr->. Qed.

Lemma congr_big : forall r1 r2 (P1 P2 : pred I) F1 F2,
  r1 = r2 -> P1 =1 P2 -> (forall i, P1 i -> F1 i = F2 i) ->
    \big[op/nil]_(i <- r1 | P1 i) F1 i = \big[op/nil]_(i <- r2 | P2 i) F2 i.
Proof. move=> r1 r2 P1 P2 F1 F2 <-{r2}; exact: eq_big. Qed.

Lemma big_seq0 : forall (P : pred I) F,
  \big[op/nil]_(i <- [::] | P i) F i = nil.
Proof. by rewrite unlock. Qed.

Lemma big_adds : forall i r (P : pred I) F,
  let x := \big[op/nil]_(j <- r | P j) F j in
  \big[op/nil]_(j <- i :: r | P j) F j = if P i then op (F i) x else x.
Proof. by rewrite unlock. Qed.

Lemma big_maps : forall (J : eqType) (h : J -> I) r F (P : pred I),
  \big[op/nil]_(i <- maps h r | P i) F i
     = \big[op/nil]_(j <- r | P (h j)) F (h j).
Proof. by rewrite unlock => J h r P F; elim: r => //= j r ->. Qed.

Lemma big_sub : forall x0 r (P : pred I) F,
  \big[op/nil]_(i <- r | P i) F i
     = \big[op/nil]_(0 <= i < size r | P (sub x0 r i)) (F (sub x0 r i)).
Proof.
by move=> x0 r P F; rewrite -{1}(mkseq_sub x0 r) big_maps /index_iota subn0.
Qed.

Lemma big_hasC : forall r (P : pred I) F,
  ~~ has P r -> \big[op/nil]_(i <- r | P i) F i = nil.
Proof.
move=> r P F; rewrite -big_filter has_count count_filter.
case: filter => // _; exact: big_seq0.
Qed.

Lemma big_pred0_eq : forall (r : seq I) F,
  \big[op/nil]_(i <- r | false) F i = nil.
Proof. by move=> r F; rewrite big_hasC // has_pred0. Qed.

Lemma big_pred0 : forall r (P : pred I) F, P =1 xpred0 ->
  \big[op/nil]_(i <- r | P i) F i = nil.
Proof. move=> r P F; move/eq_bigl->; exact: big_pred0_eq. Qed.

Lemma big_cat_nested : forall r1 r2 (P : pred I) F,
  let x := \big[op/nil]_(i <- r2 | P i) F i in
  \big[op/nil]_(i <- r1 ++ r2 | P i) F i = \big[op/x]_(i <- r1 | P i) F i.
Proof. by move=> r1 r2 P F; rewrite unlock /reducebig foldr_cat. Qed.

Lemma big_catl : forall r1 r2 (P : pred I) F, ~~ has P r2 ->
  \big[op/nil]_(i <- r1 ++ r2 | P i) F i = \big[op/nil]_(i <- r1 | P i) F i.
Proof. by move=> r1 r2 P F; rewrite big_cat_nested; move/big_hasC->. Qed.

Lemma big_catr : forall r1 r2 (P : pred I) F, ~~ has P r1 ->
  \big[op/nil]_(i <- r1 ++ r2 | P i) F i = \big[op/nil]_(i <- r2 | P i) F i.
Proof.
move=> r1 r2 P F; rewrite -big_filter -(big_filter r2) filter_cat.
by rewrite has_count count_filter; case: filter.
Qed.

Lemma big_const_seq : forall r (P : pred I) x,
  \big[op/nil]_(i <- r | P i) x = iter (count P r) (op x) nil.
Proof. by rewrite unlock => r P x; elim: r => //= i r ->; case: (P i). Qed.

End SeqExtension.

(* The following lemma can be used to localise extensionality to     *)
(* the specific index sequence. This is done by ssreflect rewriting, *)
(* before applying congruence or induction lemmas. This is important *)
(* for the latter, because ssreflect 1.1 still relies on primitive   *)
(* Coq matching unification for second-order application (e.g., for  *)
(* elim), and the latter can't handle the eqType constraint on I, as *)
(* it doesn't recognize canonical projections.                       *)
Lemma big_cond_seq : forall (I : eqType) r (P : pred I) F,
  \big[op/nil]_(i <- r | P i) F i
    = \big[op/nil]_(i <- r | P i && (i \in r)) F i.
Proof.
move=> I r P F; rewrite -!(big_filter r); congr bigop.
by apply: eq_in_filter => i ->; rewrite andbT.
Qed.

Lemma congr_big_nat : forall m1 n1 m2 n2 P1 P2 F1 F2,
    m1 = m2 -> n1 = n2 ->
    (forall i, m1 <= i < n2 -> P1 i = P2 i) ->
    (forall i, P1 i && (m1 <= i < n2) -> F1 i = F2 i) ->
  \big[op/nil]_(m1 <= i < n1 | P1 i) F1 i
    = \big[op/nil]_(m2 <= i < n2 | P2 i) F2 i.
Proof.
move=> m n _ _ P1 P2 F1 F2 <- <- eqP12 eqF12.
rewrite big_cond_seq (big_cond_seq _ P2).
apply: eq_big => i; rewrite ?inE /= !mem_index_iota; last exact: eqF12.
case inmn_i: (m <= i < n); rewrite ?(andbT, andbF) //; exact: eqP12.
Qed.

Lemma big_geq : forall m n (P : pred nat) F, m >= n ->
  \big[op/nil]_(m <= i < n | P i) F i = nil.
Proof.
by move=> m n P F ge_m_n; rewrite /index_iota (eqnP ge_m_n) big_seq0.
Qed.

Lemma big_ltn_cond : forall m n (P : pred nat) F, m < n ->
  let x := \big[op/nil]_(m.+1 <= i < n | P i) F i in
  \big[op/nil]_(m <= i < n | P i) F i = if P m then op (F m) x else x.
Proof.
by move=> m [//|n] P F le_m_n; rewrite /index_iota leq_subS // big_adds.
Qed.

Lemma big_ltn : forall m n F, m < n ->
  \big[op/nil]_(m <= i < n) F i = op (F m) (\big[op/nil]_(m.+1 <= i < n) F i).
Proof. move=> *; exact: big_ltn_cond. Qed.

Lemma big_addn : forall m n a (P : pred nat) F,
  \big[op/nil]_(m + a <= i < n | P i) F i =
     \big[op/nil]_(m <= i < n - a | P (i + a)) F (i + a).
Proof.
move=> m n a P F; rewrite /index_iota subn_sub addnC iota_addl big_maps.
by apply: eq_big => ? *; rewrite addnC.
Qed.

Lemma big_add1 : forall m n (P : pred nat) F,
  \big[op/nil]_(m.+1 <= i < n | P i) F i =
     \big[op/nil]_(m <= i < n.-1 | P (i.+1)) F (i.+1).
Proof.
move=> m n P F; rewrite -addn1 big_addn subn1.
by apply: eq_big => ? *; rewrite addn1.
Qed.

Lemma big_nat_recl : forall n F,
  \big[op/nil]_(0 <= i < n.+1) F i =
     op (F 0) (\big[op/nil]_(0 <= i < n) F i.+1).
Proof. by move=> n F; rewrite big_ltn // big_add1. Qed.

Lemma big_mkord : forall n (P : pred nat) F,
  \big[op/nil]_(0 <= i < n | P i) F i = \big[op/nil]_(i < n | P i) F i.
Proof.
move=> n P F; rewrite /index_iota subn0 -(big_maps (@nat_of_ord n)).
by congr bigop; rewrite val_enum_ord.
Qed.

Lemma big_nat_widen : forall m n1 n2 (P : pred nat) F, n1 <= n2 ->
  \big[op/nil]_(m <= i < n1 | P i) F i
      = \big[op/nil]_(m <= i < n2 | P i && (i < n1)) F i.
Proof.
move=> m n1 n2 P F len12; symmetry.
rewrite -big_filter filter_predI big_filter.
congr bigop; rewrite /index_iota; set d1 := n1 - m; set d2 := n2 - m.
rewrite -(@subnK d1 d2) /=; last by rewrite leq_sub2r ?leq_addr.
have: ~~ has (fun i => i < n1) (iota (m + d1) (d2 - d1)).
  apply/hasPn=> i; rewrite mem_iota -leqNgt; case/andP=> le_mn1_i _.
  by apply: leq_trans le_mn1_i; rewrite -leq_sub_add.
rewrite iota_add filter_cat has_filter /=; case: filter => // _.
rewrite cats0; apply/all_filterP; apply/allP=> i.
rewrite mem_iota; case/andP=> le_m_i lt_i_md1.
apply: (leq_trans lt_i_md1); rewrite subnK // ltnW //.
rewrite -ltn_0sub -(ltn_add2l m) addn0; exact: leq_trans lt_i_md1.
Qed.

Lemma big_ord_widen_cond : forall n1 n2 (P : pred nat) (F : nat -> R),
     n1 <= n2 ->
  \big[op/nil]_(i < n1 | P i) F i
      = \big[op/nil]_(i < n2 | P i && (i < n1)) F i.
Proof.
move=> n1 n2 P F len12.
by rewrite -big_mkord (big_nat_widen _ _ _ len12) big_mkord.
Qed.

Lemma big_ord_widen : forall n1 n2 (F : nat -> R),
 n1 <= n2 ->
  \big[op/nil]_(i < n1) F i = \big[op/nil]_(i < n2 | i < n1) F i.
Proof. move=> *; exact: (big_ord_widen_cond (predT)). Qed.

Lemma big_ord_widen_leq : forall n1 n2 (P : pred 'I_(n1.+1)) F,
 n1 < n2 ->
  \big[op/nil]_(i < n1.+1 | P i) F i
      = \big[op/nil]_(i < n2 | P (inord i) && (i <= n1)) F (inord i).
Proof.
move=> n1 n2 P F len12; pose g G i := G (inord i : 'I_(n1.+1)).
rewrite -(big_ord_widen_cond (g _ P) (g _ F) len12) {}/g.
by apply: eq_big => i *; rewrite inord_val.
Qed.

Lemma big_ord_narrow_cond : forall n1 n2 (P : pred 'I_n2) F,
  forall le_n1_n2 : n1 <= n2,
  let w := widen_ord le_n1_n2 in
  \big[op/nil]_(i < n2 | P i && (i < n1)) F i
    = \big[op/nil]_(i < n1 | P (w i)) F (w i).
Proof.
move=> [|n1] n2 P F ltn12 /=.
  by rewrite !big_pred0 // => [[//] | i]; rewrite andbF.
rewrite (big_ord_widen_leq _ _ ltn12); apply: eq_big => i.
  rewrite ltnS; case: leqP => [le_i_n1|_]; last by rewrite !andbF.
  by congr (P _ && _); apply: val_inj; rewrite /= inordK.
by case/andP=> _ le_i_n1; congr F; apply: val_inj; rewrite /= inordK.
Qed.

Lemma big_ord_narrow_cond_leq : forall n1 n2 (P : pred 'I_(n2.+1)) F,
  forall le_n1_n2 : n1 <= n2,
  let w := @widen_ord n1.+1 n2.+1 le_n1_n2 in
  \big[op/nil]_(i < n2.+1 | P i && (i <= n1)) F i
  = \big[op/nil]_(i < n1.+1 | P (w i)) F (w i).
Proof. move=> n1 n2; exact: big_ord_narrow_cond n1.+1 n2.+1. Qed.

Lemma big_ord_narrow : forall n1 n2 F,
  forall le_n1_n2 : n1 <= n2,
  let w := widen_ord le_n1_n2 in
  \big[op/nil]_(i < n2 | i < n1) F i = \big[op/nil]_(i < n1) F (w i).
Proof. move=> *; exact: (big_ord_narrow_cond (predT)). Qed.

Lemma big_ord_narrow_leq : forall n1 n2 F,
  forall le_n1_n2 : n1 <= n2,
  let w := @widen_ord n1.+1 n2.+1 le_n1_n2 in
  \big[op/nil]_(i < n2.+1 | i <= n1) F i = \big[op/nil]_(i < n1.+1) F (w i).
Proof. move=> *; exact: (big_ord_narrow_cond_leq (predT)). Qed.

Lemma big_ord_recl : forall n F,
  \big[op/nil]_(i < n.+1) F i =
     op (F ord0) (\big[op/nil]_(i < n) F (@lift n.+1 ord0 i)).
Proof.
move=> n F; pose G i := F (inord i).
have eqFG: forall i, F i = G i by move=> i; rewrite /G inord_val.
rewrite (eq_bigr _ (fun i _ => eqFG i)) -(big_mkord _ (fun _ => _) G) eqFG.
rewrite big_ltn // big_add1 /= big_mkord; congr op.
by apply: eq_bigr => i _; rewrite eqFG.
Qed.

Lemma big_const : forall (I : finType) (A : pred I) x,
  \big[op/nil]_(i \in A) x = iter #|A| (op x) nil.
Proof.
by move=> *; rewrite big_const_seq count_filter cardE [index_enum _]enumE.
Qed.

Lemma big_const_nat : forall m n x,
  \big[op/nil]_(m <= i < n) x = iter (n - m) (op x) nil.
Proof. by move=> *; rewrite big_const_seq count_predT size_iota. Qed.

Lemma big_const_ord : forall n x,
  \big[op/nil]_(i < n) x = iter n (op x) nil.
Proof. by move=> *; rewrite big_const card_ord. Qed.

End Extensionality.

Section MonoidProperties.

Import Monoid.

Variable R : Type.

Variable nil : R.
Notation Local "1" := nil.

Section Plain.

Variable op : Monoid.law 1.

Notation Local "'*%M'" := (operator op) (at level 0).
Notation Local "x * y" := ( *%M x y).

Lemma eq_big_nil_seq : forall nil' I r (P : pred I) F,
     right_unit nil' *%M -> has P r ->
   \big[*%M/nil']_(i <- r | P i) F i =\big[*%M/1]_(i <- r | P i) F i.
Proof.
move=> nil' I r P F op_nil'.
rewrite -!(big_filter _ _ r) has_count count_filter.
case/lastP: (filter P r) => {r p}// r i _.
by rewrite -cats1 !(big_cat_nested, big_adds, big_seq0) op_nil' mulm1.
Qed.

Lemma eq_big_nil  : forall nil' (I : finType) i0 (P : pred I) F,
     P i0 -> right_unit nil' *%M ->
  \big[*%M/nil']_(i | P i) F i =\big[*%M/1]_(i | P i) F i.
Proof.
move=> nil' I i0 P F op_nil' Pi0; apply: eq_big_nil_seq => //.
by apply/hasP; exists i0; first exact: mem_enum.
Qed.

Lemma big1_eq : forall I r (P : pred I), \big[*%M/1]_(i <- r | P i) 1 = 1.
Proof.
move=> *; rewrite big_const_seq; elim: (count _ _) => //= n ->; exact: mul1m.
Qed.

Lemma big1 : forall (I : finType) (P : pred I) F,
  (forall i, P i -> F i = 1) -> \big[*%M/1]_(i | P i) F i = 1.
Proof. by move=> I P F eq_F_1; rewrite (eq_bigr _ _ _ eq_F_1) big1_eq. Qed.

Lemma big1_seq : forall (I : eqType) r (P : pred I) F,
  (forall i, P i && (i \in r) -> F i = 1)
  -> \big[*%M/1]_(i <- r | P i) F i = 1.
Proof.
by move=> I r P F eqF1; rewrite big_cond_seq (eq_bigr _ _ _ eqF1) big1_eq.
Qed.

Lemma big_seq1 : forall I (i : I) F, \big[*%M/1]_(j <- [:: i]) F j = F i.
Proof. by rewrite unlock => /= *; rewrite mulm1. Qed.

Lemma big_mkcond : forall I r (P : pred I) F,
  \big[*%M/1]_(i <- r | P i) F i =
     \big[*%M/1]_(i <- r) (if P i then F i else 1).
Proof.
by rewrite unlock => I r P F; elim: r => //= i r ->; case P; rewrite ?mul1m.
Qed.

Lemma big_cat : forall I r1 r2 (P : pred I) F,
  \big[*%M/1]_(i <- r1 ++ r2 | P i) F i =
     \big[*%M/1]_(i <- r1 | P i) F i * \big[*%M/1]_(i <- r2 | P i) F i.
Proof.
move=> I r1 r2 P F; rewrite !(big_mkcond _ P).
elim: r1 => [|i r1 IHr1]; first by rewrite big_seq0 mul1m.
by rewrite /= !big_adds IHr1 mulmA.
Qed.

Lemma big_pred1_eq : forall (I : finType) (i : I) F,
  \big[*%M/1]_(j | j == i) F j = F i.
Proof.
by move=> I i F; rewrite -big_filter filter_index_enum enum1 big_seq1.
Qed.

Lemma big_pred1 : forall (I : finType) i (P : pred I) F,
  P =1 pred1 i -> \big[*%M/1]_(j | P j) F j = F i.
Proof. move=> I i P F; move/(eq_bigl _ _)->; exact: big_pred1_eq. Qed.

Lemma big_cat_nat : forall n m p (P : pred nat) F, m <= n -> n <= p ->
  \big[*%M/1]_(m <= i < p | P i) F i =
   (\big[*%M/1]_(m <= i < n | P i) F i) * (\big[*%M/1]_(n <= i < p | P i) F i).
Proof.
move=> n m p F P le_mn le_np; rewrite -big_cat.
by rewrite -{2}(subnK le_mn) -iota_add -subn_sub subnK // leq_sub2.
Qed.

Lemma big_nat1 : forall n F, \big[*%M/1]_(n <= i < n.+1) F i = F n.
Proof. by move=> n F; rewrite big_ltn // big_geq // mulm1. Qed.

Lemma big_nat_recr : forall n F,
  \big[*%M/1]_(0 <= i < n.+1) F i = (\big[*%M/1]_(0 <= i < n) F i) * F n.
Proof. by move=> n F; rewrite (@big_cat_nat n) ?leqnSn // big_nat1. Qed.

Lemma big_ord_recr : forall n F,
  \big[*%M/1]_(i < n.+1) F i =
     (\big[*%M/1]_(i < n) F (widen_ord (leqnSn n) i)) * F ord_max.
Proof.
move=> n F; transitivity (\big[*%M/1]_(0 <= i < n.+1) F (inord i)).
  by rewrite big_mkord; apply: eq_bigr=> i _; rewrite inord_val.
rewrite big_nat_recr big_mkord; congr (_ * F _); last first.
  by apply: val_inj; rewrite /= inordK.
by apply: eq_bigr => [] i _; congr F; apply: ord_inj; rewrite inordK //= leqW.
Qed.

End Plain.

Section Abelian.

Variable op : abelian_law 1.

Notation Local "'*%M'" := (operator (law_of_abelian op)) (at level 0).
Notation Local "x * y" := ( *%M x y).

Lemma eq_big_perm : forall (I : eqType) r1 r2 (P : pred I) F,
    perm_eq r1 r2 ->
  \big[*%M/1]_(i <- r1 | P i) F i = \big[*%M/1]_(i <- r2 | P i) F i.
Proof.
move=> I r1 r2 P F; move/perm_eqP; rewrite !(big_mkcond _ _ P).
elim: r1 r2 => [|i r1 IHr1] r2 eq_r12.
  by case: r2 eq_r12 => // i r2; move/(_ (pred1 i)); rewrite /= eqxx.
have r2i: i \in r2 by rewrite -has_pred1 has_count -eq_r12 /= eqxx.
case/splitPr: r2 / r2i => [r3 r4] in eq_r12 *; rewrite big_cat /= !big_adds.
rewrite mulmCA; congr (_ * _); rewrite -big_cat; apply: IHr1 => a.
move/(_ a): eq_r12; rewrite !count_cat /= addnCA; exact: addn_injl.
Qed.

Lemma big_uniq : forall (I : finType) (r : seq I) F,
  uniq r -> \big[*%M/1]_(i <- r) F i = \big[*%M/1]_(i | i \in r) F i.
Proof.
move=> I r F uniq_r; rewrite -(big_filter _ _ _ (mem r)); apply: eq_big_perm.
by rewrite filter_index_enum uniq_perm_eq ?uniq_enum // => i; rewrite mem_enum.
Qed.

Lemma big_split : forall I r (P : pred I) F1 F2,
  \big[*%M/1]_(i <- r | P i) (F1 i * F2 i) =
    \big[*%M/1]_(i <- r | P i) F1 i * \big[*%M/1]_(i <- r | P i) F2 i.
Proof.
rewrite unlock => I r P F1 F2.
elim: r => /= [|i r ->]; [by rewrite mulm1 | case: (P i) => //=].
rewrite !mulmA; congr (_ * _); exact: mulmAC.
Qed.

Lemma bigID : forall I r (a P : pred I) F,
  \big[*%M/1]_(i <- r | P i) F i
  = \big[*%M/1]_(i <- r | P i && a i) F i *
    \big[*%M/1]_(i <- r | P i && ~~ a i) F i.
Proof.
move=> I r a P F; rewrite !(big_mkcond _ _ _ F) -big_split; apply: eq_bigr => i.
by case: (a i); rewrite !simpm.
Qed.
Implicit Arguments bigID [I r].

Lemma bigD1 : forall (I : finType) j (P : pred I) F,
  P j -> \big[*%M/1]_(i | P i) F i
    = F j * \big[*%M/1]_(i | P i && (i != j)) F i.
Proof.
move=> I j P F Pj; rewrite (bigID (pred1 j)); congr (_ * _).
by apply: big_pred1 => i; rewrite /= andbC; case: eqP => // ->.
Qed.
Implicit Arguments bigD1 [I P F].

Lemma cardD1x : forall (I : finType) (A : pred I) j,
  A j -> #|SimplPred A| = 1 + #|[pred i | A i && (i != j)]|.
Proof.
move=> I A j Aj; rewrite (cardD1 j) [j \in A]Aj; congr (_ + _).
by apply: eq_card => i; rewrite inE /= andbC.
Qed.
Implicit Arguments cardD1x [I A].

Lemma partition_big : forall (I J : finType) (P : pred I) p (Q : pred J) F,
    (forall i, P i -> Q (p i)) ->
      \big[*%M/1]_(i | P i) F i =
         \big[*%M/1]_(j | Q j) \big[*%M/1]_(i | P i && (p i == j)) F i.
Proof.
move=> I J P p Q F Qp; transitivity (\big[*%M/1]_(i | P i && Q (p i)) F i).
  by apply: eq_bigl => i; case Pi: (P i); rewrite // Qp.
elim: {Q Qp}_.+1 {-2}Q (ltnSn #|Q|) => // n IHn Q.
case: (pickP Q) => [j Qj | Q0 _]; last first.
  by rewrite !big_pred0 // => i; rewrite Q0 andbF.
rewrite ltnS (cardD1x j Qj) (bigD1 j) //; move/IHn=> {n IHn} <-.
rewrite (bigID (fun i => p i == j)); congr (_ * _); apply: eq_bigl => i.
  by case: eqP => [-> | _]; rewrite !(Qj, simpm).
by rewrite andbA.
Qed.

Implicit Arguments partition_big [I J P F].

Lemma reindex_onto : forall (I J : finType) (h : J -> I) h' (P : pred I) F,
   (forall i, P i -> h (h' i) = i) ->
  \big[*%M/1]_(i | P i) F i =
    \big[*%M/1]_(j | P (h j) && (h' (h j) == j)) F (h j).
Proof.
move=> I J h h' P F h'K.
elim: {P}_.+1 {-3}P h'K (ltnSn #|P|) => //= n IHn P h'K.
case: (pickP P) => [i Pi | P0 _]; last first.
  by rewrite !big_pred0 // => j; rewrite P0.
rewrite ltnS (cardD1x i Pi); move/IHn {n IHn} => IH.
rewrite (bigD1 i Pi) (bigD1 (h' i)) h'K ?Pi ?eq_refl //=; congr (_ * _).
rewrite {}IH => [|j]; [apply: eq_bigl => j | by case/andP; auto].
rewrite andbC -andbA (andbCA (P _)); case: eqP => //= hK; congr (_ && ~~ _).
by apply/eqP/eqP=> [<-|->] //; rewrite h'K.
Qed.
Implicit Arguments reindex_onto [I J P F].

Lemma reindex : forall (I J : finType) (h : J -> I) (P : pred I) F,
  {on [pred i | P i], bijective h} ->
  \big[*%M/1]_(i | P i) F i = \big[*%M/1]_(j | P (h j)) F (h j).
Proof.
move=> I J h P F [h' hK h'K]; rewrite (reindex_onto h h' h'K).
by apply: eq_bigl => j; rewrite !inE; case Pi: (P _); rewrite //= hK ?eqxx.
Qed.
Implicit Arguments reindex [I J P F].

Lemma pair_big_dep : forall (I J : finType) (P : pred I) (Q : I -> pred J) F,
  \big[*%M/1]_(i | P i) \big[*%M/1]_(j | Q i j) F i j =
    \big[*%M/1]_(p | P p.1 && Q p.1 p.2) F p.1 p.2.
Proof.
move=> I J P Q F.
rewrite (partition_big (fun p => p.1) P) => [|j]; last by case/andP.
apply: eq_bigr => i /= Pi; rewrite (reindex_onto (pair i) (fun p => p.2)).
   by apply: eq_bigl => j; rewrite !eqxx [P i]Pi !andbT.
by case=> i' j /=; case/andP=> _ /=; move/eqP->.
Qed.

Lemma pair_big : forall (I J : finType) (P : pred I) (Q : pred J) F,
  \big[*%M/1]_(i | P i) \big[*%M/1]_(j | Q j) F i j =
    \big[*%M/1]_(p | P p.1 && Q p.2) F p.1 p.2.
Proof. move=> *; exact: pair_big_dep. Qed.

Lemma pair_bigA_ : forall (I J : finType) (F : I -> J -> R),
  \big[*%M/1]_i \big[*%M/1]_j F i j = \big[*%M/1]_p F p.1 p.2.
Proof. move=> *; exact: pair_big_dep. Qed.

Lemma exchange_big_dep :
    forall (I J : finType) (P : pred I) (Q : I -> pred J) (xQ : pred J) F,
    (forall i j, P i -> Q i j -> xQ j) ->
  \big[*%M/1]_(i | P i) \big[*%M/1]_(j | Q i j) F i j =
    \big[*%M/1]_(j | xQ j) \big[*%M/1]_(i | P i && Q i j) F i j.
Proof.
move=> I J P Q xQ F PQxQ; pose p u := (u.2, u.1).
rewrite !pair_big_dep (reindex_onto (p J I) (p I J)) => [|[//]].
apply: eq_big => [] [j i] //=; symmetry; rewrite eq_refl andbC.
case: (@andP (P i)) => //= [[]]; exact: PQxQ.
Qed.
Implicit Arguments exchange_big_dep [I J P Q F].

Lemma exchange_big :  forall (I J : finType) (P : pred I) (Q : pred J) F,
  \big[*%M/1]_(i | P i) \big[*%M/1]_(j | Q j) F i j =
    \big[*%M/1]_(j | Q j) \big[*%M/1]_(i | P i) F i j.
Proof.
move=> I J P Q F; rewrite (exchange_big_dep Q) //; apply: eq_bigr => i /= Qi.
by apply: eq_bigl => j; rewrite [Q i]Qi andbT.
Qed.

Lemma exchange_big_dep_nat :
  forall m1 n1 m2 n2 (P : pred nat) (Q : rel nat) (xQ : pred nat) F,
    (forall i j, m1 <= i < n1 -> m2 <= j < n2 -> P i -> Q i j -> xQ j) ->
  \big[*%M/1]_(m1 <= i < n1 | P i) \big[*%M/1]_(m2 <= j < n2 | Q i j) F i j =
    \big[*%M/1]_(m2 <= j < n2 | xQ j)
       \big[*%M/1]_(m1 <= i < n1 | P i && Q i j) F i j.
Proof.
move=> m1 n1 m2 n2 P Q xQ F PQxQ.
transitivity
  (\big[*%M/1]_(i < n1 - m1| P (i + m1))
    \big[*%M/1]_(j < n2 - m2 | Q (i + m1) (j + m2)) F (i + m1) (j + m2)).
- rewrite -{1}[m1]add0n big_addn big_mkord; apply: eq_bigr => i _.
  by rewrite -{1}[m2]add0n big_addn big_mkord.
rewrite (exchange_big_dep (fun j: 'I__ => xQ (j + m2))) => [|i j]; last first.
  by apply: PQxQ; rewrite leq_addl addnC -ltn_0sub -subn_sub ltn_0sub ltn_ord.
symmetry; rewrite -{1}[m2]add0n big_addn big_mkord; apply: eq_bigr => j _.
by rewrite -{1}[m1]add0n big_addn big_mkord.
Qed.
Implicit Arguments exchange_big_dep_nat [m1 n1 m2 n2 P Q F].

Lemma exchange_big_nat : forall m1 n1 m2 n2 (P Q : pred nat) F,
  \big[*%M/1]_(m1 <= i < n1 | P i) \big[*%M/1]_(m2 <= j < n2 | Q j) F i j =
    \big[*%M/1]_(m2 <= j < n2 | Q j) \big[*%M/1]_(m1 <= i < n1 | P i) F i j.
Proof.
move=> m1 n1 m2 n2 P Q F; rewrite (exchange_big_dep_nat Q) //.
by apply: eq_bigr => i /= Qi; apply: eq_bigl => j; rewrite [Q i]Qi andbT.
Qed.

End Abelian.

End MonoidProperties.

Implicit Arguments big_filter [R op nil I].
Implicit Arguments big_filter_cond [R op nil I].
Implicit Arguments congr_big [R op nil I r1 P1 F1].
Implicit Arguments eq_big [R op nil I r P1  F1].
Implicit Arguments eq_bigl [R op nil  I r P1].
Implicit Arguments eq_bigr [R op nil I r  P F1].
Implicit Arguments eq_big_nil [R op nil nil' I P F].
Implicit Arguments big_cond_seq [R op nil I r].
Implicit Arguments congr_big_nat [R op nil m1 n1 P1 F1].
Implicit Arguments big_maps [R op nil I J r].
Implicit Arguments big_sub [R op nil I r].
Implicit Arguments big_catl [R op nil I r1 r2 P F].
Implicit Arguments big_catr [R op nil I r1 r2  P F].
Implicit Arguments big_geq [R op nil m n P F].
Implicit Arguments big_ltn_cond [R op nil m n P F].
Implicit Arguments big_ltn [R op nil m n F].
Implicit Arguments big_addn [R op nil]. (* m n a *)
Implicit Arguments big_mkord [R op nil n].
Implicit Arguments big_nat_widen [R op nil] (* m n a *).
Implicit Arguments big_ord_widen_cond [R op nil n1].
Implicit Arguments big_ord_widen [R op nil n1].
Implicit Arguments big_ord_widen_leq [R op nil n1].
Implicit Arguments big_ord_narrow_cond [R op nil n1 n2 P F].
Implicit Arguments big_ord_narrow_cond_leq [R op nil n1 n2 P F].
Implicit Arguments big_ord_narrow [R op nil n1 n2 F].
Implicit Arguments big_ord_narrow_leq [R op nil n1 n2 F].
Implicit Arguments big_mkcond [R op nil I r].
Implicit Arguments big1_eq [R op nil I].
Implicit Arguments big1_seq [R op nil I].
Implicit Arguments big1 [R op nil I].
Implicit Arguments big_pred1 [R op nil I P F].
Implicit Arguments eq_big_perm [R op nil I r1 P F].
Implicit Arguments big_uniq [R op nil I F].
Implicit Arguments bigID [R op nil I r].
Implicit Arguments bigD1 [R op nil I P F].
Implicit Arguments partition_big [R op nil I J P F].
Implicit Arguments reindex_onto [R op nil I J P F].
Implicit Arguments reindex [R op nil I J P F].
Implicit Arguments pair_big_dep [R op nil I J].
Implicit Arguments pair_big [R op nil I J].
Implicit Arguments exchange_big_dep [R op nil I J P Q F].
Implicit Arguments exchange_big_dep_nat [R op nil m1 n1 m2 n2 P Q F].
Implicit Arguments big_ord_recl [R op nil].
Implicit Arguments big_ord_recr [R op nil].
Implicit Arguments big_nat_recl [R op nil].
Implicit Arguments big_nat_recr [R op nil].

Section BigProp.

Variables (R : Type) (Pb : R -> Type).
Variables (nil : R) (op1 op2 : R -> R -> R).
Hypothesis (Pb_nil : Pb nil)
           (Pb_op1 : forall x y, Pb x -> Pb y -> Pb (op1 x y))
           (Pb_eq_op : forall x y, Pb x -> Pb y -> op1 x y = op2 x y).

Lemma big_prop : forall I r (P : pred I) F,
  (forall i, P i -> Pb (F i)) -> Pb (\big[op1/nil]_(i <- r | P i) F i).
Proof.
by rewrite unlock => I r P F PbF; elim: r => //= i *; case Pi: (P i); auto.
Qed.

(* Pb must be given explicitly for the lemma below, because Coq second-order *)
(* unification will not handle the eqType constraint on I.                   *)
Lemma big_prop_seq : forall (I : eqType) (r : seq I) (P : pred I) F,
  (forall i, P i && (i \in r) -> Pb (F i)) ->
   Pb (\big[op1/nil]_(i <- r | P i) F i).
Proof. move=> I r P F; rewrite big_cond_seq; exact: big_prop. Qed.

(* Change operation *)
Lemma eq_big_op :  forall I r (P : pred I) F,
   (forall i, P i -> Pb (F i)) ->
  \big[op1/nil]_(i <- r | P i) F i = \big[op2/nil]_(i <- r | P i) F i.
Proof.
have:= big_prop; rewrite unlock => Pb_big I r P F Pb_F.
by elim: r => //= i r <-; case Pi: (P i); auto.
Qed.

(* See big_prop_seq above *)
Lemma eq_big_op_seq :  forall (I : eqType) r (P : pred I) F,
    (forall i, P i && (i \in r) -> Pb (F i)) ->
  \big[op1/nil]_(i <- r | P i) F i = \big[op2/nil]_(i <- r | P i) F i.
Proof. move=> I r P F Pb_F; rewrite !(big_cond_seq P); exact: eq_big_op. Qed.

End BigProp.

(* The implicit arguments expect an explicit Pb *)
Implicit Arguments eq_big_op_seq [R nil op1 I r P F].
Implicit Arguments eq_big_op [R nil op1 I P F].

Section BigRel.

Variables (R1 R2 : Type) (Pr : R1 -> R2 -> Type).
Variables (nil1 : R1) (op1 : R1 -> R1 -> R1).
Variables (nil2 : R2) (op2 : R2 -> R2 -> R2).
Hypothesis Pr_nil : Pr nil1 nil2.
Hypothesis Pr_rel : forall x1 x2 y1 y2,
  Pr x1 x2 -> Pr y1 y2 -> Pr (op1 x1 y1) (op2 x2 y2).

(* Pr must be given explicitly *)
Lemma big_rel : forall I r (P : pred I) F1 F2,
  (forall i, (P i) -> Pr (F1 i) (F2 i)) ->
  Pr (\big[op1/nil1]_(i <- r | P i) F1 i) (\big[op2/nil2]_(i <- r | P i) F2 i).
Proof.
rewrite !unlock => I r P F1 F2 PrF.
elim: r => //= i *; case Pi: (P i); auto.
Qed.

Lemma big_rel_seq : forall (I : eqType) (r : seq I) (P : pred I) F1 F2,
    (forall i, P i && (i \in r) -> Pr (F1 i) (F2 i)) ->
  Pr (\big[op1/nil1]_(i <- r | P i) F1 i) (\big[op2/nil2]_(i <- r | P i) F2 i).
Proof. move=> I r P *; rewrite !(big_cond_seq P); exact: big_rel. Qed.

End BigRel.

Implicit Arguments big_rel_seq [R1 R2 nil1 op1 nil2 op2 I r P F1 F2].
Implicit Arguments big_rel [R1 R2 nil1 op1 nil2 op2 I P F1 F2].

Section Morphism.

Variables R1 R2 : Type.
Variables (nil1 : R1) (nil2 : R2).
Variables (op1 : R1 -> R1 -> R1) (op2 : R2 -> R2 -> R2).
Variable phi : R1 -> R2.
Hypothesis phi_morphism : Monoid.morphism nil1 nil2 op1 op2 phi.

Lemma big_morph : forall I r (P : pred I) F,
  phi (\big[op1/nil1]_(i <- r | P i) F i) =
     \big[op2/nil2]_(i <- r | P i) phi (F i).
Proof.
case: phi_morphism => [phi1 phiM] I r P F.
by rewrite !unlock; elim: r => //= i r <-; case: (P i).
Qed.

End Morphism.

Implicit Arguments big_morph [R1 R2 nil1 nil2 op1 op2].

Section Distributivity.

Import Monoid.

Variable R : Type.
Variables zero one : R.
Notation Local "0" := zero.
Notation Local "1" := one.
Variable times : mul_law 0.
Notation Local "'*%M'" := (mul_operator times) (at level 0).
Notation Local "x * y" := ( *%M x y).
Variable plus : add_law times.
Notation Local "'+%M'" :=
  (operator (law_of_abelian (law_of_additive plus))) (at level 0).
Notation Local "x + y" := ( +%M x y).

Lemma big_distrl : forall I r alpha (P : pred I) F,
  \big[+%M/0]_(i <- r | P i) F i * alpha
    = \big[+%M/0]_(i <- r | P i) (F i * alpha).
Proof.
move=> *; apply: (big_morph ( *%M^~ _)).
by split=> [|? * /=]; rewrite (mul0m,  mulm_addl).
Qed.

Lemma big_distrr : forall I r alpha (P : pred I) F,
  alpha * \big[+%M/0]_(i <- r | P i) F i
    = \big[+%M/0]_(i <- r | P i) (alpha * F i).
Proof.
move=> *; apply: (big_morph ( *%M _)).
by split=> [|? * /=]; rewrite (mulm0,  mulm_addr).
Qed.

Lemma big_distr_big_dep :
  forall (I J : finType) j0 (P : pred I) (Q : I -> pred J) F,
  \big[*%M/1]_(i | P i) \big[+%M/0]_(j | Q i j) F i j =
     \big[+%M/0]_(f | pfamily j0 P Q f) \big[*%M/1]_(i | P i) F i (f i).
Proof.
move=> I J j0 P Q F; rewrite -big_filter filter_index_enum; set r := enum P.
pose fIJ := {ffun I -> J}; pose Pf := pfamily j0 _ Q; symmetry.
transitivity (\big[+%M/0]_(f | Pf (mem r) f) \big[*%M/1]_(i <- r) F i (f i)).
  apply: eq_big=> f; last by rewrite -big_filter filter_index_enum.
  by apply: eq_forallb => i; rewrite /= mem_enum.
have: uniq r by exact: uniq_enum.
elim: {P}r => /= [_|i r IHr].
  rewrite (big_pred1 [ffun => j0]) ?big_seq0 //= => f.
  apply/familyP/eqP=> /= [Df |->{f} i]; last by rewrite ffunE.
  apply/ffunP=> i; rewrite ffunE; exact/eqP.
case/andP=> nri; rewrite big_adds big_distrl; move/IHr {IHr} <-.
rewrite (partition_big (fun f : fIJ => f i) (Q i)); last first.
  by move=> f; move/familyP; move/(_ i); rewrite /= inE /= eqxx.
pose seti j (f : fIJ) := [ffun k => if k == i then j else f k].
apply: eq_bigr => j Qij; rewrite (reindex_onto (seti j) (seti j0)); last first.
  move=> f /=; case/andP; move/familyP=> eq_f; move/eqP=> fi.
  by apply/ffunP => k; rewrite !ffunE; case: eqP => // ->.
rewrite big_distrr; apply: eq_big => [f | f eq_f]; last first.
  rewrite big_adds ffunE eq_refl !(big_cond_seq predT) /=; congr (_ * _).
  by apply: eq_bigr => k; rewrite ffunE; case: eqP => // ->; case/idPn.
rewrite !ffunE !eq_refl andbT; apply/andP/familyP=> [[Pjf fij0] k | Pff].
  have:= familyP _ _ Pjf k; rewrite /= ffunE in_adds; case: eqP => // -> _.
  by rewrite (negbET nri) -(eqP fij0) !ffunE ?inE /= !eqxx.
split.
  apply/familyP=> k; move/(_ k): Pff; rewrite /= ffunE in_adds.
  by case: eqP => // ->.
apply/eqP; apply/ffunP=> k; have:= Pff k; rewrite !ffunE /=.
by case: eqP => // ->; rewrite (negbET nri) /=; move/eqP.
Qed.

Lemma big_distr_big :
  forall (I J : finType) j0 (P : pred I) (Q : pred J) F,
  \big[*%M/1]_(i | P i) \big[+%M/0]_(j | Q j) F i j =
     \big[+%M/0]_(f | pffun_on j0 P Q f) \big[*%M/1]_(i | P i) F i (f i).
Proof.
move=> I J j0 P Q F; rewrite (big_distr_big_dep j0); apply: eq_bigl => f.
by apply/familyP/familyP=> Pf i; move/(_ i): Pf; case: (P i).
Qed.

Lemma bigA_distr_big_dep :
  forall (I J : finType) (Q : I -> pred J) F,
  \big[*%M/1]_i \big[+%M/0]_(j | Q i j) F i j
    = \big[+%M/0]_(f | family Q f) \big[*%M/1]_i F i (f i).
Proof.
move=> I J Q F; case: (pickP J) => [j0 _ | J0].
   exact: (big_distr_big_dep j0).
rewrite /index_enum; case: (enum I) (mem_enum I) => [I0 | i r _].
  have f0: I -> J by move=> i; have:= I0 i.
  rewrite (big_pred1 (finfun f0)) ?big_seq0 // => g.
  by apply/familyP/eqP=> _; first apply/ffunP; move=> i; have:= I0 i.
have Q0: Q _ =1 pred0 by move=> ? j; have:= J0 j.
rewrite big_adds /= big_pred0 // mul0m big_pred0 // => f.
by apply/familyP; move/(_ i); rewrite Q0.
Qed.

Lemma bigA_distr_big :
  forall (I J : finType) (Q : pred J) (F : I -> J -> R),
  \big[*%M/1]_i \big[+%M/0]_(j | Q j) F i j
    = \big[+%M/0]_(f | ffun_on Q f) \big[*%M/1]_i F i (f i).
Proof. move=> *; exact: bigA_distr_big_dep. Qed.

Lemma bigA_distr_bigA :
  forall (I J : finType) F,
  \big[*%M/1]_(i : I) \big[+%M/0]_(j : J) F i j
    = \big[+%M/0]_(f : {ffun I -> J}) \big[*%M/1]_i F i (f i).
Proof.
move=> *; rewrite bigA_distr_big; apply: eq_bigl => ?; exact/familyP.
Qed.

End Distributivity.

Implicit Arguments big_distrl [R zero times plus I r].
Implicit Arguments big_distrr [R zero times plus I r].
Implicit Arguments big_distr_big_dep [R zero one times plus I J].
Implicit Arguments big_distr_big [R zero one times plus I J].
Implicit Arguments bigA_distr_big_dep [R zero one times plus I J].
Implicit Arguments bigA_distr_big [R zero one times plus I J].
Implicit Arguments bigA_distr_bigA [R zero one times plus I J].

Section Ring.

Import ssralg.Ring.

Section Opp.

Variable R : additive_group.

Lemma sum_opp : forall I r P (F : I -> R),
  \sum_(i <- r | P i) - F i = - (\sum_(i <- r | P i) F i).
Proof.
move=> *; symmetry; apply: big_morph.
by split=> [|x y]; rewrite (oppr0, oppr_add).
Qed.

Lemma sum_split_sub : forall I r (P : pred I) (F1 F2 : I -> R),
  \sum_(i <- r | P i) (F1 i - F2 i)
     = \sum_(i <- r | P i) F1 i - \sum_(i <- r | P i) F2 i.
Proof. by move=> *; rewrite -sum_opp -big_split /=. Qed.

Lemma sumr_const : forall (I : finType) (A : pred I) (x : R),
  \sum_(i \in A) x = x *+ #|A|.
Proof. exact: big_const. Qed.

End Opp.

Lemma prodr_const : forall (R : basic) (I : finType) (A : pred I) (x : R),
  \prod_(i \in A) x = x ^+ #|A|.
Proof. move=> *; exact: big_const. Qed.

End Ring.

(* Redundant, unparseable notation to print constant sums and products. *)
Notation "\su 'm_' ( i | P ) e" :=
  (\sum_(<- index_enum _ | (fun i => P)) (fun _ => e%N))
  (at level 41, e at level 41, format "\su 'm_' ( i  |  P )  e") : nat_scope.

Notation "\su 'm_' ( i \in A ) e" :=
  (\sum_(<- index_enum _ | (fun i => i \in A)) (fun _ => e%N))
  (at level 41, e at level 41, format "\su 'm_' ( i  \in  A )  e") : nat_scope.

Notation "\su 'm_' ( i \in A | P ) e" :=
  (\sum_(<- index_enum _ | (fun i => (i \in A) && P)) (fun _ => e%N))
  (at level 41, e at level 41, format "\su 'm_' ( i  \in  A  |  P )  e")
    : nat_scope.

Notation "\pro 'd_' ( i | P ) e" :=
  (\prod_(<- index_enum _ | (fun i => P)) (fun _ => e%N))
  (at level 36, e at level 36, format "\pro 'd_' ( i  |  P )  e") : nat_scope.

Lemma sum_nat_const : forall (I : finType) (A : pred I) (n : nat),
  \sum_(i \in A) n = #|A| * n.
Proof. by move=> I A n; rewrite big_const; elim: #|A| => //= i ->. Qed.

Lemma sum1_card : forall (I : finType) (A : pred I), \sum_(i \in A) 1 = #|A|.
Proof. by move=> I A; rewrite sum_nat_const muln1. Qed.

Lemma prod_nat_const : forall (I : finType) (A : pred I) (n : nat),
  \prod_(i \in A) n = n ^ #|A|.
Proof. by move=> I A n; rewrite big_const; elim: #|_| => //= ? ->. Qed.

Lemma sum_nat_const_nat : forall n1 n2 n : nat,
  \sum_(n1 <= i < n2) n = (n2 - n1) * n.
Proof. by move=> *; rewrite big_const_nat; elim: (_ - _) => //= ? ->. Qed.

Lemma prod_nat_const_nat : forall n1 n2 n : nat,
  \prod_(n1 <= i < n2) n = n ^ (n2 - n1).
Proof. by move=> *; rewrite big_const_nat; elim: (_ - _) => //= ? ->. Qed.

(* Beware: applying sum_predU to a [disjoint A & B] hypothesis will strip *)
(* the mem wrappers from A and B, possibly exposing internal coercions.   *)
Lemma sum_predU : forall (I : finType) (N : I -> nat) (a b : pred I),
  [disjoint a & b] ->
  \sum_(i | a i || b i) N i = (\sum_(i | a i) N i) + (\sum_(i | b i) N i).
Proof.
move => d N a b Hdisj; rewrite (bigID a) //=; congr addn; apply: eq_bigl => x0.
  by rewrite andb_orl andbb andbC [_ && _](pred0P Hdisj) orbF.
rewrite andbC; move/pred0P: Hdisj; move/(_ x0)=> /=.
by rewrite -topredE /=; case: a.
Qed.

Lemma ltn_0prodn_cond : forall I r (P : pred I) F,
  (forall i, P i -> 0 < F i) -> 0 < \prod_(i <- r | P i) F i.
Proof.
by move=> I r P F Fpos; apply big_prop => // n1 n2; rewrite ltn_0mul => ->.
Qed.

Lemma ltn_0prodn : forall I r (P : pred I) F,
  (forall i, 0 < F i) -> 0 < \prod_(i <- r | P i) F i.
Proof. move=> I r P F Fpos; exact: ltn_0prodn_cond. Qed.

Notation "\max_ ( <- r | P ) F" :=
  (\big[maxn/0%N]_(<- r | P%B) F%N) : nat_scope.
Notation "\max_ ( i <- r | P ) F" :=
  (\big[maxn/0%N]_(i <- r | P%B) F%N) : nat_scope.
Notation "\max_ ( i <- r ) F" :=
  (\big[maxn/0%N]_(i <- r) F%N) : nat_scope.
Notation "\max_ ( i | P ) F" :=
  (\big[maxn/0%N]_(i | P%B) F%N) : nat_scope.
Notation "\max_ i F" :=
  (\big[maxn/0%N]_i F%N) : nat_scope.
Notation "\max_ ( i : I | P ) F" :=
  (\big[maxn/0%N]_(i : I | P%B) F%N) (only parsing) : nat_scope.
Notation "\max_ ( i : I ) F" :=
  (\big[maxn/0%N]_(i : I) F%N) (only parsing) : nat_scope.
Notation "\max_ ( m <= i < n | P ) F" :=
 (\big[maxn/0%N]_(m <= i < n | P%B) F%N) : nat_scope.
Notation "\max_ ( m <= i < n ) F" :=
 (\big[maxn/0%N]_(m <= i < n) F%N) : nat_scope.
Notation "\max_ ( i < n | P ) F" :=
 (\big[maxn/0%N]_(i < n | P%B) F%N) : nat_scope.
Notation "\max_ ( i < n ) F" :=
 (\big[maxn/0%N]_(i < n) F%N) : nat_scope.
Notation "\max_ ( i \in A | P ) F" :=
 (\big[maxn/0%N]_(i \in A | P%B) F%N) : nat_scope.
Notation "\max_ ( i \in A ) F" :=
 (\big[maxn/0%N]_(i \in A) F%N) : nat_scope.

Lemma leq_bigmax_cond : forall (I : finType) (P : pred I) F i0,
  P i0 -> F i0 <= \max_(i | P i) F i.
Proof.
by move=> I P F i0 Pi0; rewrite -eqn_maxr (bigD1 i0) // maxnA /= maxnn eqxx.
Qed.

Lemma leq_bigmax : forall (I : finType) F (i0 : I), F i0 <= \max_i F i.
Proof. by move=> *; exact: leq_bigmax_cond. Qed.

Implicit Arguments leq_bigmax_cond [I P F].
Implicit Arguments leq_bigmax [I F].

Lemma eq_bigmax_cond : forall (I : finType) (P : pred I) F,
  ~~ pred0b P -> exists i0, P i0 && (F i0 == \max_(i | P i) F i).
Proof.
move=> I P F n0P; set m := \max_(i | P i) F i.
pose ub i := P i && (F i >= m); case: (pickP ub) => [i| ub0].
  by case/andP=> Pi ubi; exists i; rewrite Pi eqn_leq leq_bigmax_cond.
have ubm: forall i, P i -> F i < m.
  by move=> i Pi; case/nandP: (ub0 i); rewrite (Pi, ltnNge).
case/idP: (ltnn m); apply: (@big_prop _ (fun n => n < m)) => // [|n1 n2].
  by case/existsP: n0P => i; move/ubm; exact: leq_trans.
by rewrite !ltnNge leq_maxr negb_or => ->.
Qed.

Lemma eq_bigmax : forall (I : finType) F,
  (~~ pred0b I) -> exists i0 : I, (F i0 == \max_i F i).
Proof.
by move=> I F; move/(eq_bigmax_cond F)=> [] x; move/andP=> [] _; exists x.
Qed.

Implicit Arguments eq_bigmax_cond [I P F].
Implicit Arguments eq_bigmax [I F].

Unset Implicit Arguments.


(*

  Copyright 2014 Cornell University
  Copyright 2015 Cornell University
  Copyright 2016 Cornell University

  This file is part of VPrl (the Verified Nuprl project).

  VPrl is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  VPrl is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with VPrl.  If not, see <http://www.gnu.org/licenses/>.

  Websites: http://nuprl.org/html/verification/
            http://nuprl.org/html/Nuprl2Coq
            https://github.com/vrahli/NuprlInCoq

  Authors: Vincent Rahli

*)

Require Export computation8.
Require Export computation_preserves_lib.
Require Export atom_ren.
Require Export alphaeq5.

Definition abs2bot_op {o}
           (op : @Opid o)
           (bs : list BTerm) : NTerm :=
  match op with
  | Abs abs => mk_bot
  | _ => oterm op bs
  end.

Fixpoint abs2bot {o} (t : @NTerm o) : NTerm :=
  match t with
  | vterm v => vterm v
  | sterm f => sterm (fun n => abs2bot (f n))
  | oterm op bs => abs2bot_op op (map abs2bot_bterm bs)
  end
with abs2bot_bterm {o} (b : @BTerm o) : BTerm :=
       match b with
       | bterm vs t => bterm vs (abs2bot t)
       end.

Lemma subset_nil_implies_nil :
  forall T (l : list T), subset l [] -> l = [].
Proof.
  introv ss.
  destruct l as [|x l]; allsimpl; auto.
  pose proof (ss x); allsimpl; tcsp.
Qed.
Hint Resolve subset_nil_implies_nil : slow.

Lemma implies_props_abs2bot {o} :
  forall (t : @NTerm o),
    (nt_wf t -> nt_wf (abs2bot t))
      # (subset (free_vars (abs2bot t)) (free_vars t))
      # (subset (get_utokens (abs2bot t)) (get_utokens t)).
Proof.
  nterm_ind t as [v|f ind|op bs ind] Case; dands; introv h; allsimpl; auto.

  - Case "sterm".
    inversion h as [|? imp|]; subst.
    constructor; introv.
    pose proof (imp n) as q; clear imp; repnd.
    pose proof (ind n) as z; clear ind; repnd.
    apply z0 in q0.
    rw q1 in z1.
    rw q in z.
    dands; auto.

    + unfold closed; eauto 3 with slow.

    + unfold noutokens; eauto 3 with slow.

  - Case "oterm".
    unfold abs2bot_op.
    inversion  h as [| |? ? imp e]; subst; clear h.

    destruct op; allsimpl; eauto 2 with slow;
    constructor; simpl; allrw map_map; allunfold @compose.

    + introv i; allrw in_map_iff; exrepnd; subst.
      destruct a as [l t]; simpl.
      applydup ind in i1; repnd.
      constructor.
      apply i2.
      apply imp in i1.
      allrw @bt_wf_iff. auto.

    + rw <- e.
      apply eq_maps; introv i.
      destruct x as [l t]; simpl; auto.

    + introv i; allrw in_map_iff; exrepnd; subst.
      destruct a as [l t]; simpl.
      applydup ind in i1; repnd.
      constructor.
      apply i2.
      apply imp in i1.
      allrw @bt_wf_iff. auto.

    + rw <- e.
      apply eq_maps; introv i.
      destruct x as [l t]; simpl; auto.

    + introv i; allrw in_map_iff; exrepnd; subst.
      destruct a as [l t]; simpl.
      applydup ind in i1; repnd.
      constructor.
      apply i2.
      apply imp in i1.
      allrw @bt_wf_iff. auto.

    + rw <- e.
      apply eq_maps; introv i.
      destruct x as [l t]; simpl; auto.

  - Case "oterm".
    destruct op; allsimpl; tcsp; allrw lin_flat_map; exrepnd;
    allrw in_map_iff; exrepnd; subst;
    destruct a as [l t]; allsimpl;
    eexists; dands; eauto; allsimpl;
    allrw in_remove_nvars; repnd; dands; auto;
    apply ind in h1; repnd;
    apply h4 in h2; auto.

  - Case "oterm".
    destruct op; allsimpl; tcsp; allrw in_app_iff; repndors; tcsp;
    allrw lin_flat_map; exrepnd; try right;
    destruct x0 as [l t]; allsimpl;
    allrw in_map_iff; exrepnd;
    destruct a as [l1 t1]; allsimpl; ginv;
    applydup ind in h1; repnd;
    eexists; dands; eauto.
Qed.

Lemma isprog_sterm_abs2bot {o} :
  forall (f : @ntseq o),
    isprog (sterm f)
    -> isprog (sterm (fun n => abs2bot (f n))).
Proof.
  introv isp.
  allrw @isprog_eq.
  inversion isp as [cl wf].
  rw @nt_wf_sterm_iff in wf.
  apply nt_wf_sterm_implies_isprogram.
  apply wfst; introv.
  pose proof (wf n) as k; clear wf; repnd.
  pose proof (implies_props_abs2bot (f n)) as h; repnd.
  autodimp h0 hyp.
  rw k1 in h1.
  rw k in h.
  apply subset_nil_implies_nil in h1.
  apply subset_nil_implies_nil in h.
  dands; auto.
Qed.
Hint Resolve isprog_sterm_abs2bot : slow.

Lemma implies_isprog_abs2bot {o} :
  forall (t : @NTerm o),
    isprog t
    -> isprog (abs2bot t).
Proof.
  introv isp.
  allrw @isprog_eq.
  inversion isp as [cl wf].
  pose proof (implies_props_abs2bot t) as h; repnd.
  constructor; auto.
  rw cl in h1.
  apply subset_nil_implies_nil; auto.
Qed.
Hint Resolve implies_isprog_abs2bot : slow.

Lemma isnoncan_like_abs2bot {o} :
  forall (t : @NTerm o),
    isnoncan_like t -> isnoncan_like (abs2bot t).
Proof.
  destruct t as [v|f|op bs]; unfold isnoncan_like; simpl; tcsp.
  intro h.
  destruct op; tcsp.
Qed.
Hint Resolve isnoncan_like_abs2bot : slow.

Lemma eapply_wf_def_sterm {o} :
  forall (f : @ntseq o),
    eapply_wf_def (sterm f).
Proof.
  introv.
  unfold eapply_wf_def; left; eexists; eauto.
Qed.
Hint Resolve eapply_wf_def_sterm : slow.

Fixpoint abs2bot_sub {o} (sub : @Sub o) : Sub :=
  match sub with
  | [] => []
  | (v,t) :: sub => (v,abs2bot t) :: abs2bot_sub sub
  end.

Lemma dec_op_abs {o} :
  forall (op : @Opid o),
    decidable {abs : opabs & op = Abs abs}.
Proof.
  introv; unfold decidable.
  dopid op as [can|ncan|exc|abs] Case; try (complete (right; sp; ginv)).
  left; exists abs; auto.
Qed.

Lemma abs2bot_op_eq {o} :
  forall op (bs : list (@BTerm o)),
    abs2bot_op op bs
    = if dec_op_abs op
      then mk_bot
      else oterm op bs.
Proof.
  introv.
  destruct op; boolvar; exrepnd; simpl; ginv; tcsp.
  destruct n; eexists; eauto.
Qed.

Hint Rewrite @lsubst_aux_allvars_preserves_osize2 : slow.

Lemma unfold_lsubst2 {o} :
  forall vars (sub : @Sub o) t,
    {t' : NTerm
     & alpha_eq t t'
     # disjoint (bound_vars t') (vars ++ sub_free_vars sub)
     # alpha_eq (lsubst t sub) (lsubst_aux t' sub)}.
Proof.
  introv.
  pose proof (unfold_lsubst sub t) as h; exrepnd.
  pose proof (change_bvars_alpha_wspec (vars ++ sub_free_vars sub) t') as q.
  destruct q as [t'' q]; repnd.
  exists t''; dands; eauto 3 with slow.
  rewrite h0.
  apply lsubst_aux_alpha_congr_same_disj; auto.
  allrw disjoint_app_l; repnd; eauto 3 with slow.
Qed.

Hint Rewrite @sub_free_vars_var_ren : hslow.
Hint Resolve disjoint_dom_sub_filt2 : slow.
Hint Resolve subset_sub_bound_vars_sub_filter : slow.

Definition abs2vbot_op {o}
           v
           (op : @Opid o)
           (bs : list BTerm) : NTerm :=
  match op with
  | Abs abs => mk_vbot v
  | _ => oterm op bs
  end.

Fixpoint abs2vbot {o} v (t : @NTerm o) : NTerm :=
  match t with
  | vterm v => vterm v
  | sterm f => sterm (fun n => abs2vbot v (f n))
  | oterm op bs => abs2vbot_op v op (map (abs2vbot_bterm v) bs)
  end
with abs2vbot_bterm {o} v (b : @BTerm o) : BTerm :=
       match b with
       | bterm vs t => bterm vs (abs2vbot v t)
       end.

Lemma abs2vbot_op_eq {o} :
  forall v op (bs : list (@BTerm o)),
    abs2vbot_op v op bs
    = if dec_op_abs op
      then mk_vbot v
      else oterm op bs.
Proof.
  introv.
  destruct op; boolvar; exrepnd; simpl; ginv; tcsp.
  destruct n; eexists; eauto.
Qed.

Lemma abs2bot_as_abs2vbot {o} :
  forall (t : @NTerm o), abs2bot t = abs2vbot nvarx t.
Proof.
  nterm_ind t as [v|f ind|op bs ind] Case; introv; allsimpl; tcsp.

  - Case "sterm".
    f_equal.
    apply functional_extensionality; introv; auto.

  - Case "oterm".
    rewrite abs2bot_op_eq.
    rewrite abs2vbot_op_eq.
    boolvar; auto.
    f_equal.
    apply eq_maps; introv i.
    destruct x as [l t]; allsimpl.
    f_equal.
    eapply ind; eauto.
Qed.

Fixpoint abs2vbot_sub {o} v (sub : @Sub o) : Sub :=
  match sub with
  | [] => []
  | (x,t) :: sub => (x,abs2vbot v t) :: abs2vbot_sub v sub
  end.

Lemma sub_find_abs2vbot_sub {o} :
  forall v (sub : @Sub o) x,
    sub_find (abs2vbot_sub v sub) x
    = match sub_find sub x with
      | Some t => Some (abs2vbot v t)
      | None => None
      end.
Proof.
  induction sub; simpl; introv; tcsp; repnd; allsimpl.
  boolvar; auto.
Qed.

Lemma sub_filter_abs2vbot_sub {o} :
  forall v (sub : @Sub o) l,
    sub_filter (abs2vbot_sub v sub) l
    = abs2vbot_sub v (sub_filter sub l).
Proof.
  induction sub; introv; simpl; auto.
  repnd; simpl; boolvar; simpl; auto.
  rewrite IHsub; auto.
Qed.

Lemma abs2vbot_lsubst_aux {o} :
  forall v (t : @NTerm o) sub,
    abs2vbot v (lsubst_aux t sub)
    = lsubst_aux (abs2vbot v t) (abs2vbot_sub v sub).
Proof.
  nterm_ind t as [x|f ind|op bs ind] Case; introv; simpl; auto.

  - Case "vterm".
    rewrite sub_find_abs2vbot_sub.
    remember (sub_find sub x) as sf; symmetry in Heqsf; destruct sf; auto.

  - Case "oterm".
    repeat (rewrite abs2vbot_op_eq).
    boolvar; simpl; autorewrite with slow; auto.
    f_equal.
    allrw map_map; unfold compose; simpl.
    apply eq_maps; introv i.
    destruct x as [l t]; allsimpl.
    f_equal.
    rewrite sub_filter_abs2vbot_sub.
    eapply ind; eauto.
Qed.

Lemma abs2vbot_sub_var_ren {o} :
  forall v l1 l2, @abs2vbot_sub o v (var_ren l1 l2) = var_ren l1 l2.
Proof.
  induction l1; introv; simpl; auto.
  destruct l2; simpl; auto.
  fold (@var_ren o l1 l2).
  rewrite IHl1; auto.
Qed.
Hint Rewrite @abs2vbot_sub_var_ren : slow.

Lemma implies_alpha_eq_abs2vbot {o} :
  forall v1 v2 (t1 t2 : @NTerm o),
    alpha_eq t1 t2
    -> alpha_eq (abs2vbot v1 t1) (abs2vbot v2 t2).
Proof.
  nterm_ind1s t1 as [x|f ind|op bs ind] Case; introv aeq; allsimpl.

  - Case "vterm".
    inversion aeq; subst; simpl; auto.

  - Case "sterm".
    inversion aeq as [|? ? imp|]; clear aeq; subst; allsimpl.
    constructor.
    introv.
    apply ind; auto.

  - Case "oterm".
    apply alpha_eq_oterm_implies_combine in aeq; exrepnd; subst; allsimpl.
    repeat (rewrite abs2vbot_op_eq).
    boolvar; eauto 3 with slow.

    apply alpha_eq_oterm_combine; allrw map_length; dands; auto.
    introv i.
    rewrite <- map_combine in i.
    apply in_map_iff in i; exrepnd; allsimpl; ginv.
    destruct a0 as [l1 t1].
    destruct a as [l2 t2]; allsimpl.

    applydup aeq0 in i1.

    pose proof (fresh_vars
                  (length l1)
                  ((all_vars t1)
                     ++ all_vars t2
                     ++ all_vars (abs2vbot v1 t1)
                     ++ all_vars (abs2vbot v2 t2))) as fv.
    exrepnd.
    allrw disjoint_app_r; repnd.

    apply (alphabt_change_var_aux _ _ _ _ lvn) in i0; auto;
    [|allrw disjoint_app_r; auto].
    repnd.

    apply (al_bterm_aux lvn); auto;
    [allrw disjoint_app_r; auto|].

    pose proof (ind t1 (lsubst_aux t1 (var_ren l1 lvn)) l1) as q; clear ind.
    autorewrite with slow in *.
    repeat (autodimp q hyp); eauto 3 with slow.
    apply q in i2; clear q.
    repeat (rewrite abs2vbot_lsubst_aux in i2).
    autorewrite with slow in *; auto.
Qed.
Hint Resolve implies_alpha_eq_abs2vbot : slow.

Lemma implies_alphaeq_sub_abs2vbot_sub {o} :
  forall v1 v2 (sub1 sub2 : @Sub o),
    alphaeq_sub sub1 sub2
    -> alphaeq_sub (abs2vbot_sub v1 sub1) (abs2vbot_sub v2 sub2).
Proof.
  induction sub1; introv aeq; inversion aeq; subst; auto; clear aeq; simpl.
  constructor; eauto 3 with slow.
  apply alphaeq_eq.
  apply implies_alpha_eq_abs2vbot.
  apply alphaeq_eq; auto.
Qed.

Lemma abs2bot_sub_as_abs2vbot_sub {o} :
  forall (sub : @Sub o), abs2bot_sub sub = abs2vbot_sub nvarx sub.
Proof.
  induction sub; allsimpl; auto.
  repnd; allsimpl; rewrite IHsub.
  rewrite abs2bot_as_abs2vbot; auto.
Qed.

Lemma subset_free_vars_abs2vbot {o} :
  forall v (t : @NTerm o),
    subset (free_vars (abs2vbot v t)) (free_vars t).
Proof.
  nterm_ind1s t as [x|f ind|op bs ind] Case; simpl; auto.
  Case "oterm".
  rewrite abs2vbot_op_eq; boolvar; simpl; autorewrite with slow; auto.
  rewrite flat_map_map; unfold compose; simpl.
  apply subset_flat_map2; introv i.
  destruct x as [l t]; simpl.
  apply subvars_eq.
  apply implies_subvars_remove_nvars.
  apply subvars_eq.
  eapply ind; eauto 3 with slow.
Qed.

Lemma subset_bound_vars_abs2vbot {o} :
  forall v (t : @NTerm o),
    subset (bound_vars (abs2vbot v t)) (v :: bound_vars t).
Proof.
  nterm_ind1s t as [x|f ind|op bs ind] Case; simpl; auto.
  Case "oterm".
  rewrite abs2vbot_op_eq; boolvar; simpl; eauto 3 with slow.
  rewrite flat_map_map; unfold compose; simpl.
  apply subset_flat_map; introv i.
  destruct x as [l t]; simpl.
  rw subset_app; dands.
  - apply subset_cons1.
    introv j; rw lin_flat_map; eexists; dands; eauto.
    simpl; rw in_app_iff; sp.
  - introv j.
    eapply ind in j; eauto 3 with slow.
    allsimpl; repndors; tcsp.
    right; apply lin_flat_map.
    eexists; dands; eauto.
    simpl; apply in_app_iff; sp.
Qed.

Lemma subset_sub_free_vars_abs2vbot_sub {o} :
  forall v (sub : @Sub o),
    subset (sub_free_vars (abs2vbot_sub v sub)) (sub_free_vars sub).
Proof.
  induction sub; simpl; auto.
  repnd; allsimpl.
  apply subset_app_lr; auto.
  apply subset_free_vars_abs2vbot.
Qed.

Lemma abs2bot_lsubst {o} :
  forall (t : @NTerm o) sub,
    alpha_eq
      (abs2bot (lsubst t sub))
      (lsubst (abs2bot t) (abs2bot_sub sub)).
Proof.
  introv.

  pose proof (ex_fresh_var (sub_free_vars sub)) as fv; exrepnd.
  repeat (rewrite abs2bot_as_abs2vbot).

  eapply alpha_eq_trans;
    [apply (implies_alpha_eq_abs2vbot _ v _ (lsubst t sub));
      eauto 3 with slow|].

  pose proof (unfold_lsubst sub t) as q; exrepnd; allsimpl.
  rewrite q0; clear q0.

  rewrite abs2bot_sub_as_abs2vbot_sub.

  eapply alpha_eq_trans;
    [|apply lsubst_alpha_congr3;
       [apply alpha_eq_refl
       |apply (implies_alphaeq_sub_abs2vbot_sub v _ sub _);
         eauto 3 with slow]
    ].

  pose proof (unfold_lsubst (abs2vbot_sub v sub) (abs2vbot nvarx t)) as h; exrepnd.
  rewrite h0; clear h0.

  rewrite abs2vbot_lsubst_aux.

  apply lsubst_aux_alpha_congr_same_disj;auto;[eauto 4 with slow|];[].

  eapply subset_disjoint;[apply subset_bound_vars_abs2vbot|].

  eapply subset_disjoint_r;[|apply subset_sub_free_vars_abs2vbot_sub].
  apply disjoint_cons_l; dands; auto.
Qed.

Lemma isexc_abs2bot {o} :
  forall (t : @NTerm o), isexc t -> isexc (abs2bot t).
Proof.
  introv ise.
  apply isexc_implies2 in ise; exrepnd; subst; simpl; auto.
Qed.
Hint Resolve isexc_abs2bot : slow.

Definition same_sign_bs {o} (bs1 bs2 : list (@BTerm o)) :=
  map num_bvars bs1 = map num_bvars bs2.

Definition same_sign_bs_abs2bot {o} :
  forall (bs : list (@BTerm o)),
    same_sign_bs bs (map abs2bot_bterm bs).
Proof.
  introv; unfold same_sign_bs.
  rewrite map_map; unfold compose.
  apply eq_maps; introv i.
  destruct x as [l t]; unfold num_bvars; simpl; auto.
Qed.
Hint Resolve same_sign_bs_abs2bot : slow.

Lemma eapply_wf_def_oterm_change_bs {o} :
  forall (op : @Opid o) bs1 bs2,
   same_sign_bs bs1 bs2
    -> eapply_wf_def (oterm op bs1)
    -> eapply_wf_def (oterm op bs2).
Proof.
  introv len eap.
  allunfold @eapply_wf_def; repndors; exrepnd;
  allunfold @mk_nseq; allunfold @mk_lam; ginv.

  - unfold same_sign_bs in len; allsimpl.
    destruct bs2; allsimpl; ginv; eauto.

  - unfold same_sign_bs in len; allsimpl.
    unfold num_bvars in len; allsimpl.
    destruct bs2 as [|bt l]; allsimpl; ginv.
    destruct l; allsimpl; ginv.
    destruct bt as [l t]; allsimpl.
    destruct l as [|x l]; allsimpl; ginv.
    destruct l; ginv; eauto.
Qed.
Hint Resolve eapply_wf_def_oterm_change_bs : slow.

Lemma isvalue_like_abs2bot {o} :
  forall (t : @NTerm o), isvalue_like t -> isvalue_like (abs2bot t).
Proof.
  introv i.
  apply isvalue_like_implies_or1 in i.
  unfold is_can_or_exc in i; repndors.
  - apply iscan_implies in i; repndors; exrepnd; subst; simpl; eauto 3 with slow.
  - apply isexc_implies2 in i; exrepnd; subst; eauto 3 with slow.
Qed.
Hint Resolve isvalue_like_abs2bot : slow.

Lemma alpha_eq_mk_fresh_not_in {o} :
  forall v1 v2 (t : @NTerm o),
    !LIn v1 (free_vars t)
    -> !LIn v2 (free_vars t)
    -> alpha_eq (mk_fresh v1 t) (mk_fresh v2 t).
Proof.
  introv ni1 ni2.
  apply alpha_eq_oterm_combine; simpl; dands; auto.
  introv h; repndors; tcsp; ginv.
  apply alpha_eq_bterm_bterm_disjoint;
    try (apply disjoint_singleton_l); auto.
Qed.
Hint Resolve alpha_eq_mk_fresh_not_in : slow.

Lemma  pushdown_fresh_abs2bot {o} :
  forall n (t : @NTerm o),
    isvalue_like t
    -> alpha_eq
         (pushdown_fresh n (abs2bot t))
         (abs2bot (pushdown_fresh n t)).
Proof.
  introv isv.
  unfold pushdown_fresh.
  destruct t as [v|f|op bs]; simpl; auto.
  repeat (rewrite abs2bot_op_eq).
  boolvar; simpl; auto.

  - exrepnd; subst.
    unfold isvalue_like in isv; allsimpl; tcsp.

  - unfold mk_fresh_bterms.
    allrw map_map; unfold compose; simpl.
    apply alpha_eq_oterm_combine2.
    autorewrite with slow.
    dands; auto.
    introv i.
    rewrite <- map_combine in i.
    apply in_map_iff in i; exrepnd; ginv.
    apply in_combine_same in i1; repnd; subst.
    destruct a as [l t]; allsimpl.
    apply alpha_eq_bterm_congr; fold_terms.

    unfold maybe_new_var; boolvar; auto.

    pose proof (newvar_prop (abs2bot t)) as k.
    remember (newvar (abs2bot t)) as nv1; clear Heqnv1.

    pose proof (newvar_prop t) as h.
    remember (newvar t) as nv2; clear Heqnv2.

    assert (!LIn nv2 (free_vars (abs2bot t))) as j.
    {
      intro j.
      pose proof (implies_props_abs2bot t) as z; repnd.
      apply z1 in j; auto.
    }

    eauto 3 with slow.
Qed.

Lemma implies_nt_wf_abs2bot {o} :
  forall (t : @NTerm o), nt_wf t -> nt_wf (abs2bot t).
Proof.
  introv.
  pose proof (implies_props_abs2bot t); tcsp.
Qed.
Hint Resolve implies_nt_wf_abs2bot : slow.

Fixpoint abs2vbot_utok_sub {o} v (sub : @utok_sub o) : utok_sub :=
  match sub with
  | [] => []
  | (x,t) :: sub => (x,abs2vbot v t) :: abs2vbot_utok_sub v sub
  end.

Fixpoint abs2bot_utok_sub {o} (sub : @utok_sub o) : utok_sub :=
  match sub with
  | [] => []
  | (x,t) :: sub => (x,abs2bot t) :: abs2bot_utok_sub sub
  end.

Lemma utoks_sub_find_abs2vbot_utok_sub {o} :
  forall v (sub : @utok_sub o) a,
    utok_sub_find (abs2vbot_utok_sub v sub) a
    = match utok_sub_find sub a with
      | Some t => Some (abs2vbot v t)
      | None => None
      end.
Proof.
  induction sub; introv; simpl; auto.
  repnd; simpl; boolvar; auto.
Qed.

Lemma abs2vbot_subst_utokens_aux {o} :
  forall v (t : @NTerm o) sub,
    abs2vbot v (subst_utokens_aux t sub)
    = subst_utokens_aux (abs2vbot v t) (abs2vbot_utok_sub v sub).
Proof.
  nterm_ind t as [x|f ind|op bs ind] Case; introv; auto.

  Case "oterm".
  rewrite subst_utokens_aux_oterm.
  simpl.
  repeat (rewrite abs2vbot_op_eq).
  boolvar; try (rewrite subst_utokens_aux_oterm); simpl.

  - exrepnd; subst; simpl; auto.

  - remember (get_utok op) as guo; symmetry in Heqguo; destruct guo; simpl;
    allrw @map_map; unfold compose.

    + apply get_utok_some in Heqguo; subst; allsimpl.
      unfold subst_utok.
      rewrite utoks_sub_find_abs2vbot_utok_sub.
      remember (utok_sub_find sub g) as f; symmetry in Heqf; destruct f; auto.
      simpl.
      f_equal.
      allrw map_map; unfold compose.
      apply eq_maps; introv i.
      destruct x as [l t]; simpl.
      f_equal; eauto.

    + rewrite abs2vbot_op_eq; boolvar; tcsp; GC.
      f_equal.
      apply eq_maps; introv i.
      destruct x as [l t]; simpl.
      f_equal; eauto.
Qed.

Lemma abs2bot_utok_sub_as_abs2vbot_utok_sub {o} :
  forall (sub : @utok_sub o), abs2bot_utok_sub sub = abs2vbot_utok_sub nvarx sub.
Proof.
  induction sub; allsimpl; auto.
  repnd; allsimpl; rewrite IHsub.
  rewrite abs2bot_as_abs2vbot; auto.
Qed.

Lemma implies_alphaeq_utok_sub_abs2vbot_utok_sub {o} :
  forall v1 v2 (sub1 sub2 : @utok_sub o),
    alphaeq_utok_sub sub1 sub2
    -> alphaeq_utok_sub (abs2vbot_utok_sub v1 sub1) (abs2vbot_utok_sub v2 sub2).
Proof.
  induction sub1; introv aeq; inversion aeq; subst; auto; clear aeq; simpl.
  constructor; eauto 3 with slow.
  apply alphaeq_eq.
  apply implies_alpha_eq_abs2vbot.
  apply alphaeq_eq; auto.
Qed.

Lemma subset_free_vars_utok_sub_abs2vbot_utok_sub {o} :
  forall v (sub : @utok_sub o),
    subset
      (free_vars_utok_sub (abs2vbot_utok_sub v sub))
      (free_vars_utok_sub sub).
Proof.
  induction sub; simpl; auto.
  repnd; allsimpl.
  apply subset_app_lr; auto.
  apply subset_free_vars_abs2vbot.
Qed.

Lemma abs2bot_subst_utokens {o} :
  forall (t : @NTerm o) sub,
    alpha_eq
      (abs2bot (subst_utokens t sub))
      (subst_utokens (abs2bot t) (abs2bot_utok_sub sub)).
Proof.
  introv.

  pose proof (ex_fresh_var (free_vars_utok_sub sub)) as fv; exrepnd.
  repeat (rewrite abs2bot_as_abs2vbot).

  eapply alpha_eq_trans;
    [apply (implies_alpha_eq_abs2vbot _ v _ (subst_utokens t sub));
      eauto 3 with slow|].

  pose proof (unfold_subst_utokens sub t) as q; exrepnd; allsimpl.
  rewrite q0; clear q0.

  rewrite abs2bot_utok_sub_as_abs2vbot_utok_sub.

  eapply alpha_eq_trans;
    [|apply alpha_eq_subst_utokens;
       [apply alpha_eq_refl
       |apply (implies_alphaeq_utok_sub_abs2vbot_utok_sub v _ sub _);
         eauto 3 with slow]
    ].

  pose proof (unfold_subst_utokens (abs2vbot_utok_sub v sub) (abs2vbot nvarx t)) as h; exrepnd.
  rewrite h0; clear h0.

  rewrite abs2vbot_subst_utokens_aux.

  apply alpha_eq_subst_utokens_aux;eauto 4 with slow.

  eapply subset_disjoint_r;[|apply subset_bound_vars_abs2vbot].

  eapply subset_disjoint;[apply subset_free_vars_utok_sub_abs2vbot_utok_sub|].
  apply disjoint_cons_r; dands; eauto 3 with slow.
Qed.

Hint Resolve wf_term_subst : slow.

Lemma compute_step_abs2bot {o} :
  forall (t : @NTerm o) u,
    wf_term t
    -> compute_step [] t = csuccess u
    -> {w : NTerm
        & compute_step [] (abs2bot t) = csuccess w
        # alpha_eq w (abs2bot u)}.
Proof.
  nterm_ind1s t as [v|f ind|op bs ind] Case; introv wf comp.

  - Case "vterm".
    csunf; allsimpl; ginv.

  - Case "sterm".
    csunf comp; allsimpl; ginv; auto.
    eexists; csunf; simpl; dands; eauto.

  - Case "oterm".
    dopid op as [can|ncan|exc|abs] SCase.

    + SCase "Can".
      csunf comp; allsimpl; ginv; auto.
      eexists; csunf; simpl; dands; eauto.

    + SCase "NCan".
      destruct bs as [|b1 bs]; try (complete (allsimpl; ginv)).
      destruct b1 as [l t]; try (complete (allsimpl; ginv)).
      destruct l; try (complete (allsimpl; ginv)).

      {
        destruct t as [x|f|op bts]; try (complete (allsimpl; ginv));[|].

        - csunf comp; allsimpl.
          dopid_noncan ncan SSCase; allsimpl; ginv; auto.

          {
            SSCase "NApply".
            apply compute_step_seq_apply_success in comp; exrepnd; subst; allsimpl.
            csunf; simpl; auto.
            eexists; dands; eauto.
          }

          {
            SSCase "NEApply".

            apply compute_step_eapply_success in comp; exrepnd; subst.
            repndors; exrepnd; allsimpl; subst.

            + apply compute_step_eapply2_success in comp1; repnd; subst.
              repndors; exrepnd; subst; ginv.
              csunf; simpl.
              dcwf h; simpl.
              boolvar; try omega.
              rewrite Znat.Nat2Z.id; auto.
              eexists; dands; eauto.

            + csunf; simpl.
              apply isexc_implies2 in comp0; exrepnd; subst.
              dcwf h; simpl; auto.
              eexists; dands; eauto.

            + fold_terms.
              rewrite compute_step_eapply_iscan_isnoncan_like; eauto 3 with slow.
              pose proof (ind arg2 arg2 []) as h; clear ind.
              repeat (autodimp h hyp); eauto 3 with slow.
              apply wf_term_eapply_iff in wf; exrepnd; allunfold @nobnd; ginv.
              apply h in comp1; clear h; auto.
              exrepnd; rewrite comp1.
              eexists; dands; eauto.
              simpl; repeat prove_alpha_eq4.
          }

          {
            SSCase "NFix".
            apply compute_step_fix_success in comp; repnd; subst.
            csunf; simpl; auto.
            eexists; dands; eauto.
          }

          {
            SSCase "NCbv".
            apply compute_step_cbv_success in comp; exrepnd; subst.
            csunf; simpl; auto.
            eexists; dands; eauto.
            eapply alpha_eq_trans;[|apply alpha_eq_sym; apply abs2bot_lsubst]; auto.
          }

          {
            SSCase "NTryCatch".
            apply compute_step_try_success in comp; exrepnd; subst; allsimpl.
            csunf; simpl.
            eexists; dands; eauto.
          }

          {
            SSCase "NCanTest".
            apply compute_step_seq_can_test_success in comp; exrepnd; subst; allsimpl.
            csunf; simpl.
            eexists; dands; eauto.
          }

        - dopid op as [can2|ncan2|exc2|abs2] SSCase.

          + SSCase "Can".
            dopid_noncan ncan SSSCase.

            {
              SSSCase "NApply".

              csunf comp; allsimpl.
              apply compute_step_apply_success in comp.
              repndors; exrepnd; subst; auto; csunf; simpl; eexists; dands; eauto.
              eapply alpha_eq_trans;[|apply alpha_eq_sym; apply abs2bot_lsubst]; auto.
            }

            {
              SSSCase "NEApply".

              csunf comp; allsimpl.
              apply compute_step_eapply_success in comp.
              repndors; exrepnd; subst; auto.
              repndors; exrepnd; subst; allsimpl; auto.

              - apply compute_step_eapply2_success in comp1; repnd; subst.
                repndors; exrepnd; subst; auto; ginv.

                + unfold mk_lam in *; ginv.
                  csunf; simpl.
                  dcwf h; simpl.
                  apply iscan_implies in comp0; repndors; exrepnd; subst; simpl; auto;
                  eexists; dands; eauto;
                  eapply alpha_eq_trans;
                  try (apply alpha_eq_sym; apply abs2bot_lsubst); auto.

                + unfold mk_nseq in *; allsimpl; ginv; GC.
                  csunf; simpl.
                  dcwf h; simpl.
                  boolvar; simpl; auto; try omega.
                  rewrite Znat.Nat2Z.id; auto.
                  eexists; dands; eauto.

              - fold_terms; rewrite compute_step_eapply_iscan_isexc; eauto 3 with slow.

              - fold_terms; rewrite compute_step_eapply_iscan_isnoncan_like; eauto 3 with slow.

                pose proof (ind arg2 arg2 []) as q; clear ind.
                repeat (autodimp q hyp); eauto 2 with slow.
                apply wf_term_eapply_iff in wf; exrepnd; allunfold @nobnd; ginv.
                apply q in comp1; clear q; auto.
                exrepnd; rewrite comp1; auto.
                eexists; dands; eauto.
                repeat prove_alpha_eq4.
            }

            {
              SSSCase "NFix".

              csunf comp; allsimpl.
              apply compute_step_fix_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl; eexists; dands; eauto.
            }

            {
              SSSCase "NSpread".

              csunf comp; allsimpl.
              apply compute_step_spread_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl; eexists; dands; eauto.
              eapply alpha_eq_trans;[|apply alpha_eq_sym; apply abs2bot_lsubst]; auto.
            }

            {
              SSSCase "NDsup".

              csunf comp; allsimpl.
              apply compute_step_dsup_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl; eexists; dands; eauto.
              eapply alpha_eq_trans;[|apply alpha_eq_sym; apply abs2bot_lsubst]; auto.
            }

            {
              SSSCase "NDecide".

              csunf comp; allsimpl.
              apply compute_step_decide_success in comp.
              repndors; exrepnd; subst; auto.
              repndors; exrepnd; subst; auto;
              csunf; simpl; eexists; dands; eauto;
              eapply alpha_eq_trans;
              try (apply alpha_eq_sym; apply abs2bot_lsubst); auto.
            }

            {
              SSSCase "NCbv".

              csunf comp; allsimpl.
              apply compute_step_cbv_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl; eexists; dands; eauto.
              eapply alpha_eq_trans;
                try (apply alpha_eq_sym; apply abs2bot_lsubst); auto.
            }

            {
              SSSCase "NSleep".

              csunf comp; allsimpl.
              apply compute_step_sleep_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl.
              unfold compute_step_sleep; simpl.
              eexists; dands; eauto.
            }

            {
              SSSCase "NTUni".

              csunf comp; allsimpl.
              apply compute_step_tuni_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl.
              unfold compute_step_tuni; simpl.
              boolvar; try omega.
              rewrite Znat.Nat2Z.id; auto.
              eexists; dands; eauto.
            }

            {
              SSSCase "NMinus".

              csunf comp; allsimpl.
              apply compute_step_minus_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl.
              unfold compute_step_minus; simpl.
              eexists; dands; eauto.
            }

            {
              SSSCase "NFresh".

              csunf comp; allsimpl; ginv.
            }

            {
              SSSCase "NTryCatch".

              csunf comp; allsimpl.
              apply compute_step_try_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl.
              eexists; dands; eauto.
            }

            {
              SSSCase "NParallel".

              csunf comp; allsimpl.
              apply compute_step_parallel_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl.
              unfold compute_step_parallel.
              eexists; dands; eauto.
            }

            {
              SSSCase "NCompOp".

              apply compute_step_ncompop_can1_success in comp; repnd.
              repndors; exrepnd; allsimpl; subst; tcsp; simpl.

              - csunf; simpl.
                dcwf h.
                apply compute_step_compop_success_can_can in comp1; exrepnd; subst; ginv; GC.
                repndors; exrepnd; subst; allsimpl;
                unfold compute_step_comp; allrw;
                eexists; dands; eauto;
                boolvar; auto.

              - rewrite compute_step_ncompop_ncanlike2; eauto 3 with slow.
                dcwf h.
                pose proof (ind t t []) as q; clear ind.
                repeat (autodimp q hyp); eauto 2 with slow.
                allrw @wf_term_ncompop_iff; exrepnd; ginv.
                apply q in comp4; clear q; auto.
                exrepnd.
                rewrite comp2; auto.
                eexists; dands; eauto.
                repeat prove_alpha_eq4.

              - csunf; simpl.
                apply isexc_implies2 in comp1; exrepnd; subst.
                dcwf h; simpl; auto.
                eexists; dands; eauto.
            }

            {
              SSSCase "NArithOp".

              apply compute_step_narithop_can1_success in comp; repnd.
              repndors; exrepnd; allsimpl; subst; tcsp; allsimpl.

              - csunf; simpl.
                dcwf h.
                apply compute_step_arithop_success_can_can in comp1; exrepnd; subst; ginv; GC.
                repndors; exrepnd; subst; allsimpl;
                unfold compute_step_comp; allrw;
                eexists; dands; eauto;
                boolvar; auto.

              - rewrite compute_step_narithop_ncanlike2; eauto 3 with slow.
                dcwf h.
                pose proof (ind t t []) as q; clear ind.
                repeat (autodimp q hyp); eauto 2 with slow.
                allrw @wf_term_narithop_iff; exrepnd; ginv.
                apply q in comp4; clear q; auto.
                exrepnd.
                rewrite comp2; auto.
                eexists; dands; eauto.
                repeat prove_alpha_eq4.

              - csunf; simpl.
                apply isexc_implies2 in comp1; exrepnd; subst.
                dcwf h; simpl; auto.
                eexists; dands; eauto.
            }

            {
              SSSCase "NCanTest".

              csunf comp; allsimpl.
              apply compute_step_can_test_success in comp.
              repndors; exrepnd; subst; auto.
              csunf; simpl.
              eexists; dands; eauto.
              destruct (canonical_form_test_for c can2); auto.
            }

          + SSCase "NCan".

            csunf comp; allsimpl.
            remember (compute_step [] (oterm (NCan ncan2) bts)) as c.
            destruct c; allsimpl; ginv.
            symmetry in Heqc.

            pose proof (ind
                          (oterm (NCan ncan2) bts)
                          (oterm (NCan ncan2) bts) []) as q; clear ind.
            repeat (autodimp q hyp); eauto 2 with slow.

            applydup @wf_oterm_iff in wf; repnd.
            pose proof (wf0 (bterm [] (oterm (NCan ncan2) bts))) as wfn; allsimpl.
            autodimp wfn hyp.
            allrw @wf_bterm_iff.

            apply q in Heqc; clear q; auto.
            exrepnd.
            csunf; allsimpl.
            rewrite Heqc1; auto; simpl.
            eexists; dands; eauto.
            repeat prove_alpha_eq4.

          + SSCase "Exc".

            csunf comp; allsimpl.
            apply compute_step_catch_success in comp.
            repndors; exrepnd; subst; allsimpl; ginv.

            * csunf; simpl; auto.
              eexists; dands; eauto.
              unfold mk_atom_eq.
              repeat prove_alpha_eq4.
              eapply alpha_eq_trans;
                try (apply alpha_eq_sym; apply abs2bot_lsubst); auto.

            * csunf; simpl; auto.
              rewrite compute_step_catch_if_diff; auto.
              eexists; dands; eauto.

          + SSCase "Abs".

            csunf comp; allsimpl; ginv.
      }

      {
        csunf comp; allsimpl.
        apply compute_step_fresh_success in comp; exrepnd; subst.
        repndors; exrepnd; subst; ginv.

        - csunf; simpl; boolvar; auto.
          eexists; dands; eauto.

        - rewrite compute_step_fresh_if_isvalue_like2; simpl; eauto 3 with slow.
          eexists; dands; eauto.
          apply pushdown_fresh_abs2bot; auto.

        - rewrite compute_step_fresh_if_isnoncan_like; simpl; eauto 3 with slow.

          allrw @wf_fresh_iff.

          pose proof (ind t (subst t n (mk_utoken (get_fresh_atom t))) [n]) as q; clear ind.
          repeat (autodimp q hyp); eauto 2 with slow.
          { rewrite simple_osize_subst; eauto 2 with slow. }
          apply q in comp2; clear q; eauto 3 with slow;[].
          exrepnd; allsimpl.

          pose proof (abs2bot_lsubst t [(n,mk_utoken (get_fresh_atom t))]) as aeq.
          pose proof (compute_step_alpha
                        []
                        (abs2bot (lsubst t [(n, mk_utoken (get_fresh_atom t))]))
                        (lsubst (abs2bot t) (abs2bot_sub [(n, mk_utoken (get_fresh_atom t))]))
                        w) as comp.
          repeat (autodimp comp hyp).
          { apply implies_nt_wf_abs2bot.
            apply nt_wf_subst; eauto 2 with slow. }
          exrepnd; allsimpl.
          fold_terms; allrw @fold_subst.

          assert (!LIn (get_fresh_atom t) (get_utokens (abs2bot t))) as ni1.
          {
            intro h.
            pose proof (implies_props_abs2bot t) as q; repnd.
            apply q in h.
            apply get_fresh_atom_prop in h; tcsp.
          }

          assert (!LIn (get_fresh_atom (abs2bot t)) (get_utokens (abs2bot t))) as ni2.
          {
            intro h.
            apply get_fresh_atom_prop in h; tcsp.
          }

          pose proof (compute_step_subst_utoken
                        []
                        (abs2bot t)
                        t2'
                        [(n, mk_utoken (get_fresh_atom t))]) as comp'.
          repeat (autodimp comp' hyp); simpl; eauto 3 with slow.

          { unfold get_utokens_sub; simpl.
            apply disjoint_singleton_l; auto. }

          exrepnd; allsimpl.

          pose proof (comp'0 [(n, mk_utoken (get_fresh_atom (abs2bot t)))]) as comp''.
          allsimpl.
          repeat (autodimp comp'' hyp); eauto 3 with slow.

          { unfold get_utokens_sub; simpl.
            apply disjoint_singleton_l; auto. }

          exrepnd; allsimpl.
          allrw @fold_subst.
          rewrite comp''1; simpl.
          eexists; dands; eauto.

          apply implies_alpha_eq_mk_fresh.

          rename comp''0 into aeq1.
          assert (alpha_eq (subst w0 n (mk_utoken (get_fresh_atom t))) (abs2bot x)) as aeq2.
          { eauto 4 with slow. }

          unfold get_utokens_sub in *; allsimpl.
          allrw disjoint_singleton_l.

          eapply alpha_eq_trans;
            [|apply alpha_eq_sym; apply abs2bot_subst_utokens].
          simpl.

          eapply alpha_eq_trans;
            [apply alpha_eq_subst_utokens_same;exact aeq1|].

          eapply alpha_eq_trans;
            [apply simple_alphaeq_subst_utokens_subst;
              intro i; apply comp'4 in i; auto|].

          eapply alpha_eq_trans;
            [|apply alpha_eq_subst_utokens_same;exact aeq2].

          eapply alpha_eq_trans;
            [|apply alpha_eq_sym;apply simple_alphaeq_subst_utokens_subst;auto].

          auto.
      }

    + SCase "Exc".

      csunf comp; allsimpl; ginv.
      csunf; simpl.
      eexists; dands; eauto.

    + SCase "Abs".

      csunf comp; allsimpl.
      apply compute_step_lib_success in comp.
      exrepnd; subst.
      unfold found_entry in comp0; allsimpl; ginv.
Qed.

(*
*** Local Variables:
*** coq-load-path: ("." "../util/" "../terms/")
*** End:
*)