Require Import Coq.Lists.List.
Import ListNotations.
Require Import Lia.
[Loading ML file ring_plugin.cmxs (using legacy method) ... done]
[Loading ML file zify_plugin.cmxs (using legacy method) ... done]
[Loading ML file micromega_plugin.cmxs (using legacy method) ... done]

Inductive perm {A} : list A -> list A -> Prop :=
  | perm_nil : perm [] []
  | perm_skip : forall x l1 l2, perm l1 l2 -> perm (x :: l1) (x :: l2)
  | perm_swap : forall x y l, perm (y :: x :: l) (x :: y :: l)
  | perm_trans : forall l1 l2 l3, perm l1 l2 -> perm l2 l3 -> perm l1 l3.

Lemma perm_refl {A} (l : list A) : perm l l.
A: Type
l: list A
perm l l
Proof.
A: Type
l: list A
perm l l
  induction l; constructor; auto.
Qed.

Lemma perm_sym {A} (l1 l2 : list A) : perm l1 l2 -> perm l2 l1.
A: Type
l1, l2: list A
perm l1 l2 -> perm l2 l1
Proof.
A: Type
l1, l2: list A
perm l1 l2 -> perm l2 l1
  induction 1; econstructor; eauto.
Qed.

Fixpoint sum (l : list nat) : nat :=
  match l with
  | [] => 0
  | x :: l' => x + sum l'
  end.

Lemma perm_sum l1 l2 : perm l1 l2 -> sum l1 = sum l2.
l1, l2: list nat
perm l1 l2 -> sum l1 = sum l2
Proof.
l1, l2: list nat
perm l1 l2 -> sum l1 = sum l2
  induction 1; simpl; lia.
Qed.

Fixpoint reverse {A} (l : list A) : list A :=
  match l with
  | [] => []
  | x :: l' => reverse l' ++ [x]
  end.

Lemma perm_cons {A} (x : A) (l1 l2 : list A) : perm l1 l2 -> perm (x :: l1) (x :: l2).
A: Type
x: A
l1, l2: list A
perm l1 l2 -> perm (x :: l1) (x :: l2)
Proof.
A: Type
x: A
l1, l2: list A
perm l1 l2 -> perm (x :: l1) (x :: l2)
  induction 1; eauto using perm_skip, perm_swap, perm_nil, perm_trans.
Qed.

Lemma perm_swaplast {A} (x : A) (l : list A) : perm (x :: l) (l ++ [x]).
A: Type
x: A
l: list A
perm (x :: l) (l ++ [x])
Proof.
A: Type
x: A
l: list A
perm (x :: l) (l ++ [x])
  induction l; simpl; eauto using perm_skip, perm_swap, perm_nil, perm_trans.
Qed.

Lemma reverse_perm {A} (l : list A) : perm l (reverse l).
A: Type
l: list A
perm l (reverse l)
Proof.
A: Type
l: list A
perm l (reverse l)
  induction l; simpl.
A: Type
perm [] []
A: Type
a: A
l: list A
IHl: perm l (reverse l)
perm (a :: l) (reverse l ++ [a])
  -
A: Type
perm [] [] constructor.
  -
A: Type
a: A
l: list A
IHl: perm l (reverse l)
perm (a :: l) (reverse l ++ [a]) eapply perm_trans.
A: Type
a: A
l: list A
IHl: perm l (reverse l)
perm (a :: l) ?l2
A: Type
a: A
l: list A
IHl: perm l (reverse l)
perm ?l2 (reverse l ++ [a])
    +
A: Type
a: A
l: list A
IHl: perm l (reverse l)
perm (a :: l) ?l2 eapply perm_cons.
A: Type
a: A
l: list A
IHl: perm l (reverse l)
perm l ?l2 eauto.
    +
A: Type
a: A
l: list A
IHl: perm l (reverse l)
perm (a :: reverse l) (reverse l ++ [a]) eapply perm_swaplast.
Qed.

Lemma sum_reverse (l : list nat) : sum (reverse l) = sum l.
l: list nat
sum (reverse l) = sum l
Proof.
l: list nat
sum (reverse l) = sum l
  apply perm_sum.
l: list nat
perm (reverse l) l apply perm_sym.
l: list nat
perm l (reverse l) apply reverse_perm.
Qed. 

(* Now we do the same using setoids *)
Import Coq.Setoids.Setoid Morphisms.

Global Instance perm_equivalence {A} : Equivalence (@perm A).
A: Type
Equivalence perm
Proof.
A: Type
Equivalence perm
  constructor.
A: Type
Reflexive perm
A: Type
Symmetric perm
A: Type
Transitive perm
  -
A: Type
Reflexive perm intros ?.
A: Type
x: list A
perm x x apply perm_refl.
  -
A: Type
Symmetric perm intros ??.
A: Type
x, y: list A
perm x y -> perm y x apply perm_sym.
  -
A: Type
Transitive perm intros ???.
A: Type
x, y, z: list A
perm x y -> perm y z -> perm x z apply perm_trans.
Qed.

Global Instance sum_proper : Proper (perm ==> eq) sum.
Proper (perm ==> eq) sum
Proof.
Proper (perm ==> eq) sum
  intros l1 l2 H.
l1, l2: list nat
H: perm l1 l2
sum l1 = sum l2 apply perm_sum.
l1, l2: list nat
H: perm l1 l2
perm l1 l2 eauto.
Qed.

Lemma sum_reverse' (l : list nat) : sum (reverse l) = sum l.
l: list nat
sum (reverse l) = sum l
Proof.
l: list nat
sum (reverse l) = sum l
  setoid_rewrite <-reverse_perm.
l: list nat
sum l = sum l
  reflexivity.
Qed.

Global Instance reverse_proper {A} : Proper (perm ==> perm) (@reverse A).
A: Type
Proper (perm ==> perm) reverse
Proof.
A: Type
Proper (perm ==> perm) reverse
  intros l1 l2 H.
A: Type
l1, l2: list A
H: perm l1 l2
perm (reverse l1) (reverse l2)
  setoid_rewrite <-reverse_perm.
A: Type
l1, l2: list A
H: perm l1 l2
perm l1 l2 
  auto.
Qed.

Print "==>". (* R ==> S' := fun f g => forall x y, R x y -> R' (f x) (g y) *)
respectful =
let U := Type in
fun (A B : U) (R : relation A) (R' : relation B)
  (f g : A -> B) =>
forall x y : A, R x y -> R' (f x) (g y)
     : forall A B : Type,
       relation A -> relation B -> relation (A -> B)

Arguments respectful {A B}%type_scope
  (R R')%signature_scope _ _
Print Proper. (* Proper R x := R x x *)
Proper =
let U := Type in
fun (A : U) (R : relation A) (m : A) => R m m
     : forall A : Type, relation A -> A -> Prop

Arguments Proper {A}%type_scope R%signature_scope m