/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Simon Hudon, Mario Carneiro
-/

import algebra.group.defs
import data.bracket
import logic.function.basic

/-!
# Basic lemmas about semigroups, monoids, and groups

This file lists various basic lemmas about semigroups, monoids, and groups. Most proofs are
one-liners from the corresponding axioms. For the definitions of semigroups, monoids and groups, see
`algebra/group/defs.lean`.
-/

universe u

section associative
variables {α : Type u} (f : α → α → α) [is_associative α f] (x y : α)

/--
Composing two associative operations of `f : α → α → α` on the left
is equal to an associative operation on the left.
-/
lemma comp_assoc_left : (f x) ∘ (f y) = (f (f x y)) :=
by { ext z, rw [function.comp_apply, @is_associative.assoc _ f] }

/--
Composing two associative operations of `f : α → α → α` on the right
is equal to an associative operation on the right.
-/
lemma comp_assoc_right : (λ z, f z x) ∘ (λ z, f z y) = (λ z, f z (f y x)) :=
by { ext z, rw [function.comp_apply, @is_associative.assoc _ f] }

end associative

section semigroup
variables {α : Type*}

/--
Composing two multiplications on the left by `y` then `x`
is equal to a multiplication on the left by `x * y`.
-/
@[simp, to_additive
"Composing two additions on the left by `y` then `x`
is equal to a addition on the left by `x + y`."]
lemma comp_mul_left [semigroup α] (x y : α) :
  ((*) x) ∘ ((*) y) = ((*) (x * y)) :=
comp_assoc_left _ _ _

/--
Composing two multiplications on the right by `y` and `x`
is equal to a multiplication on the right by `y * x`.
-/
@[simp, to_additive
"Composing two additions on the right by `y` and `x`
is equal to a addition on the right by `y + x`."]
lemma comp_mul_right [semigroup α] (x y : α) :
  (* x) ∘ (* y) = (* (y * x)) :=
comp_assoc_right _ _ _

end semigroup

section mul_one_class
variables {M : Type u} [mul_one_class M]

@[to_additive]
lemma ite_mul_one {P : Prop} [decidable P] {a b : M} :
  ite P (a * b) 1 = ite P a 1 * ite P b 1 :=
by { by_cases h : P; simp [h], }

@[to_additive]
lemma ite_one_mul {P : Prop} [decidable P] {a b : M} :
  ite P 1 (a * b) = ite P 1 a * ite P 1 b :=
by { by_cases h : P; simp [h], }

@[to_additive]
lemma eq_one_iff_eq_one_of_mul_eq_one {a b : M} (h : a * b = 1) : a = 1 ↔ b = 1 :=
by split; { rintro rfl, simpa using h }

@[to_additive]
lemma one_mul_eq_id : ((*) (1 : M)) = id := funext one_mul

@[to_additive]
lemma mul_one_eq_id : (* (1 : M)) = id := funext mul_one

end mul_one_class

section comm_semigroup
variables {G : Type u} [comm_semigroup G]

@[no_rsimp, to_additive]
lemma mul_left_comm : ∀ a b c : G, a * (b * c) = b * (a * c) :=
left_comm has_mul.mul mul_comm mul_assoc

@[to_additive]
lemma mul_right_comm : ∀ a b c : G, a * b * c = a * c * b :=
right_comm has_mul.mul mul_comm mul_assoc

@[to_additive]
theorem mul_mul_mul_comm (a b c d : G) : (a * b) * (c * d) = (a * c) * (b * d) :=
by simp only [mul_left_comm, mul_assoc]

end comm_semigroup

local attribute [simp] mul_assoc sub_eq_add_neg

section add_monoid
variables {M : Type u} [add_monoid M] {a b c : M}

@[simp] lemma bit0_zero : bit0 (0 : M) = 0 := add_zero _
@[simp] lemma bit1_zero [has_one M] : bit1 (0 : M) = 1 :=
by rw [bit1, bit0_zero, zero_add]

end add_monoid

section comm_monoid
variables {M : Type u} [comm_monoid M] {x y z : M}

@[to_additive] lemma inv_unique (hy : x * y = 1) (hz : x * z = 1) : y = z :=
left_inv_eq_right_inv (trans (mul_comm _ _) hy) hz

end comm_monoid

section left_cancel_monoid

variables {M : Type u} [left_cancel_monoid M] {a b : M}

@[simp, to_additive] lemma mul_right_eq_self : a * b = a ↔ b = 1 :=
calc a * b = a ↔ a * b = a * 1 : by rw mul_one
           ... ↔ b = 1         : mul_left_cancel_iff

@[simp, to_additive] lemma self_eq_mul_right : a = a * b ↔ b = 1 :=
eq_comm.trans mul_right_eq_self

end left_cancel_monoid

section right_cancel_monoid

variables {M : Type u} [right_cancel_monoid M] {a b : M}

@[simp, to_additive] lemma mul_left_eq_self : a * b = b ↔ a = 1 :=
calc a * b = b ↔ a * b = 1 * b : by rw one_mul
           ... ↔ a = 1         : mul_right_cancel_iff

@[simp, to_additive] lemma self_eq_mul_left : b = a * b ↔ a = 1 :=
eq_comm.trans mul_left_eq_self

end right_cancel_monoid

section has_involutive_inv
variables {G : Type u} [has_involutive_inv G] {a b : G}

@[simp, to_additive]
lemma inv_involutive : function.involutive (has_inv.inv : G → G) := inv_inv

@[simp, to_additive]
lemma inv_surjective : function.surjective (has_inv.inv : G → G) :=
inv_involutive.surjective

@[to_additive]
lemma inv_injective : function.injective (has_inv.inv : G → G) :=
inv_involutive.injective

@[simp, to_additive] theorem inv_inj {a b : G} : a⁻¹ = b⁻¹ ↔ a = b := inv_injective.eq_iff

@[to_additive]
lemma eq_inv_of_eq_inv (h : a = b⁻¹) : b = a⁻¹ :=
by simp [h]

@[to_additive]
theorem eq_inv_iff_eq_inv : a = b⁻¹ ↔ b = a⁻¹ :=
⟨eq_inv_of_eq_inv, eq_inv_of_eq_inv⟩

@[to_additive]
theorem inv_eq_iff_inv_eq  : a⁻¹ = b ↔ b⁻¹ = a :=
eq_comm.trans $ eq_inv_iff_eq_inv.trans eq_comm

end has_involutive_inv

section div_inv_monoid

variables {G : Type u} [div_inv_monoid G]

@[to_additive]
lemma inv_eq_one_div (x : G) :
  x⁻¹ = 1 / x :=
by rw [div_eq_mul_inv, one_mul]

@[to_additive]
lemma mul_one_div (x y : G) :
  x * (1 / y) = x / y :=
by rw [div_eq_mul_inv, one_mul, div_eq_mul_inv]

@[to_additive]
lemma mul_div_assoc (a b c : G) : a * b / c = a * (b / c) :=
by rw [div_eq_mul_inv, div_eq_mul_inv, mul_assoc _ _ _]

@[to_additive]
lemma mul_div_assoc' (a b c : G) : a * (b / c) = (a * b) / c :=
(mul_div_assoc _ _ _).symm

@[simp, to_additive] lemma one_div (a : G) : 1 / a = a⁻¹ :=
(inv_eq_one_div a).symm

end div_inv_monoid

section group
variables {G : Type u} [group G] {a b c d : G}

@[simp, to_additive]
lemma inv_mul_cancel_right (a b : G) : a * b⁻¹ * b = a :=
by simp [mul_assoc]

@[simp, to_additive neg_zero]
lemma one_inv : 1⁻¹ = (1 : G) :=
inv_eq_of_mul_eq_one (one_mul 1)

@[to_additive]
theorem left_inverse_inv (G) [group G] :
  function.left_inverse (λ a : G, a⁻¹) (λ a, a⁻¹) :=
inv_inv

@[simp, to_additive]
theorem inv_eq_one : a⁻¹ = 1 ↔ a = 1 := inv_injective.eq_iff' one_inv

@[simp, to_additive]
theorem one_eq_inv : 1 = a⁻¹ ↔ a = 1 := eq_comm.trans inv_eq_one

@[to_additive]
theorem inv_ne_one : a⁻¹ ≠ 1 ↔ a ≠ 1 := not_congr inv_eq_one

@[simp, to_additive] theorem div_eq_inv_self : a / b = b⁻¹ ↔ a = 1 :=
by rw [div_eq_mul_inv, mul_left_eq_self]

@[simp, to_additive]
lemma mul_inv_cancel_left (a b : G) : a * (a⁻¹ * b) = b :=
by rw [← mul_assoc, mul_right_inv, one_mul]

@[to_additive]
theorem mul_left_surjective (a : G) : function.surjective ((*) a) :=
λ x, ⟨a⁻¹ * x, mul_inv_cancel_left a x⟩

@[to_additive]
theorem mul_right_surjective (a : G) : function.surjective (λ x, x * a) :=
λ x, ⟨x * a⁻¹, inv_mul_cancel_right x a⟩

@[simp, to_additive neg_add_rev]
lemma mul_inv_rev (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
inv_eq_of_mul_eq_one $ by simp

@[to_additive]
lemma eq_inv_of_mul_eq_one (h : a * b = 1) : a = b⁻¹ :=
have a⁻¹ = b, from inv_eq_of_mul_eq_one h,
by simp [this.symm]

@[to_additive]
lemma eq_mul_inv_of_mul_eq (h : a * c = b) : a = b * c⁻¹ :=
by simp [h.symm]

@[to_additive]
lemma eq_inv_mul_of_mul_eq (h : b * a = c) : a = b⁻¹ * c :=
by simp [h.symm]

@[to_additive]
lemma inv_mul_eq_of_eq_mul (h : b = a * c) : a⁻¹ * b = c :=
by simp [h]

@[to_additive]
lemma mul_inv_eq_of_eq_mul (h : a = c * b) : a * b⁻¹ = c :=
by simp [h]

@[to_additive]
lemma eq_mul_of_mul_inv_eq (h : a * c⁻¹ = b) : a = b * c :=
by simp [h.symm]

@[to_additive]
lemma eq_mul_of_inv_mul_eq (h : b⁻¹ * a = c) : a = b * c :=
by simp [h.symm, mul_inv_cancel_left]

@[to_additive]
lemma mul_eq_of_eq_inv_mul (h : b = a⁻¹ * c) : a * b = c :=
by rw [h, mul_inv_cancel_left]

@[to_additive]
lemma mul_eq_of_eq_mul_inv (h : a = c * b⁻¹) : a * b = c :=
by simp [h]

@[to_additive]
theorem mul_eq_one_iff_eq_inv : a * b = 1 ↔ a = b⁻¹ :=
⟨eq_inv_of_mul_eq_one, λ h, by rw [h, mul_left_inv]⟩

@[to_additive]
theorem mul_eq_one_iff_inv_eq : a * b = 1 ↔ a⁻¹ = b :=
by rw [mul_eq_one_iff_eq_inv, eq_inv_iff_eq_inv, eq_comm]

@[to_additive]
theorem eq_inv_iff_mul_eq_one : a = b⁻¹ ↔ a * b = 1 :=
mul_eq_one_iff_eq_inv.symm

@[to_additive]
theorem inv_eq_iff_mul_eq_one : a⁻¹ = b ↔ a * b = 1 :=
mul_eq_one_iff_inv_eq.symm

@[to_additive]
theorem eq_mul_inv_iff_mul_eq : a = b * c⁻¹ ↔ a * c = b :=
⟨λ h, by rw [h, inv_mul_cancel_right], λ h, by rw [← h, mul_inv_cancel_right]⟩

@[to_additive]
theorem eq_inv_mul_iff_mul_eq : a = b⁻¹ * c ↔ b * a = c :=
⟨λ h, by rw [h, mul_inv_cancel_left], λ h, by rw [← h, inv_mul_cancel_left]⟩

@[to_additive]
theorem inv_mul_eq_iff_eq_mul : a⁻¹ * b = c ↔ b = a * c :=
⟨λ h, by rw [← h, mul_inv_cancel_left], λ h, by rw [h, inv_mul_cancel_left]⟩

@[to_additive]
theorem mul_inv_eq_iff_eq_mul : a * b⁻¹ = c ↔ a = c * b :=
⟨λ h, by rw [← h, inv_mul_cancel_right], λ h, by rw [h, mul_inv_cancel_right]⟩

@[to_additive]
theorem mul_inv_eq_one : a * b⁻¹ = 1 ↔ a = b :=
by rw [mul_eq_one_iff_eq_inv, inv_inv]

@[to_additive]
theorem inv_mul_eq_one : a⁻¹ * b = 1 ↔ a = b :=
by rw [mul_eq_one_iff_eq_inv, inv_inj]

@[to_additive]
lemma div_left_injective : function.injective (λ a, a / b) :=
by simpa only [div_eq_mul_inv] using λ a a' h, mul_left_injective (b⁻¹) h

@[to_additive]
lemma div_right_injective : function.injective (λ a, b / a) :=
by simpa only [div_eq_mul_inv] using λ a a' h, inv_injective (mul_right_injective b h)

@[simp, to_additive neg_sub]
lemma inv_div' (a b : G) : (a / b)⁻¹ = b / a :=
by rw [div_eq_mul_inv, div_eq_mul_inv, mul_inv_rev, inv_inv]

@[simp, to_additive sub_add_cancel]
lemma div_mul_cancel' (a b : G) : a / b * b = a :=
by rw [div_eq_mul_inv, inv_mul_cancel_right a b]

@[simp, to_additive sub_self]
lemma div_self' (a : G) : a / a = 1 :=
by rw [div_eq_mul_inv, mul_right_inv a]

@[simp, to_additive add_sub_cancel]
lemma mul_div_cancel'' (a b : G) : a * b / b = a :=
by rw [div_eq_mul_inv, mul_inv_cancel_right a b]

@[to_additive eq_of_sub_eq_zero]
lemma eq_of_div_eq_one' (h : a / b = 1) : a = b :=
calc a = a / b * b : (div_mul_cancel' a b).symm
   ... = b         : by rw [h, one_mul]

@[to_additive]
lemma div_ne_one_of_ne (h : a ≠ b) : a / b ≠ 1 :=
mt eq_of_div_eq_one' h

@[simp, to_additive]
lemma div_inv_eq_mul (a b : G) : a / (b⁻¹) = a * b :=
by rw [div_eq_mul_inv, inv_inv]

local attribute [simp] mul_assoc

@[to_additive]
lemma mul_div (a b c : G) : a * (b / c) = a * b / c :=
by simp only [mul_assoc, div_eq_mul_inv]

@[to_additive]
lemma div_mul_eq_div_div_swap (a b c : G) : a / (b * c) = a / c / b :=
by simp only [mul_assoc, mul_inv_rev , div_eq_mul_inv]

@[simp, to_additive]
lemma mul_div_mul_right_eq_div (a b c : G) : (a * c) / (b * c) = a / b :=
by rw [div_mul_eq_div_div_swap]; simp only [mul_left_inj, eq_self_iff_true, mul_div_cancel'']

@[to_additive eq_sub_of_add_eq]
lemma eq_div_of_mul_eq' (h : a * c = b) : a = b / c :=
by simp [← h]

@[to_additive sub_eq_of_eq_add]
lemma div_eq_of_eq_mul'' (h : a = c * b) : a / b = c :=
by simp [h]

@[to_additive]
lemma eq_mul_of_div_eq (h : a / c = b) : a = b * c :=
by simp [← h]

@[to_additive]
lemma mul_eq_of_eq_div (h : a = c / b) : a * b = c :=
by simp [h]

@[simp, to_additive]
lemma div_right_inj : a / b = a / c ↔ b = c :=
div_right_injective.eq_iff

@[simp, to_additive]
lemma div_left_inj : b / a = c / a ↔ b = c :=
by { rw [div_eq_mul_inv, div_eq_mul_inv], exact mul_left_inj _ }

@[simp, to_additive sub_add_sub_cancel]
lemma div_mul_div_cancel' (a b c : G) : (a / b) * (b / c) = a / c :=
by rw [← mul_div_assoc, div_mul_cancel']

@[simp, to_additive sub_sub_sub_cancel_right]
lemma div_div_div_cancel_right' (a b c : G) : (a / c) / (b / c) = a / b :=
by rw [← inv_div' c b, div_inv_eq_mul, div_mul_div_cancel']

@[to_additive]
theorem div_div_assoc_swap : a / (b / c) = a * c / b :=
by simp only [mul_assoc, mul_inv_rev, inv_inv, div_eq_mul_inv]

@[to_additive]
theorem div_eq_one : a / b = 1 ↔ a = b :=
⟨eq_of_div_eq_one', λ h, by rw [h, div_self']⟩

alias div_eq_one ↔ _ div_eq_one_of_eq
alias sub_eq_zero ↔ _ sub_eq_zero_of_eq

@[to_additive]
theorem div_ne_one : a / b ≠ 1 ↔ a ≠ b :=
not_congr div_eq_one

@[simp, to_additive]
theorem div_eq_self : a / b = a ↔ b = 1 :=
by rw [div_eq_mul_inv, mul_right_eq_self, inv_eq_one]

-- The unprimed version is used by `group_with_zero`.  This is the preferred choice.
-- See https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/.60div_one'.60
@[simp, to_additive sub_zero]
lemma div_one' (a : G) : a / 1 = a :=
div_eq_self.2 rfl

@[to_additive eq_sub_iff_add_eq]
theorem eq_div_iff_mul_eq' : a = b / c ↔ a * c = b :=
by rw [div_eq_mul_inv, eq_mul_inv_iff_mul_eq]

@[to_additive]
theorem div_eq_iff_eq_mul : a / b = c ↔ a = c * b :=
by rw [div_eq_mul_inv, mul_inv_eq_iff_eq_mul]

@[to_additive]
theorem eq_iff_eq_of_div_eq_div (H : a / b = c / d) : a = b ↔ c = d :=
by rw [← div_eq_one, H, div_eq_one]

@[to_additive]
theorem left_inverse_div_mul_left (c : G) : function.left_inverse (λ x, x / c) (λ x, x * c) :=
assume x, mul_div_cancel'' x c

@[to_additive]
theorem left_inverse_mul_left_div (c : G) : function.left_inverse (λ x, x * c) (λ x, x / c) :=
assume x, div_mul_cancel' x c

@[to_additive]
theorem left_inverse_mul_right_inv_mul (c : G) :
  function.left_inverse (λ x, c * x) (λ x, c⁻¹ * x) :=
assume x, mul_inv_cancel_left c x

@[to_additive]
theorem left_inverse_inv_mul_mul_right (c : G) :
  function.left_inverse (λ x, c⁻¹ * x) (λ x, c * x) :=
assume x, inv_mul_cancel_left c x

@[to_additive]
lemma exists_npow_eq_one_of_zpow_eq_one {n : ℤ} (hn : n ≠ 0) {x : G} (h : x ^ n = 1) :
  ∃ n : ℕ, 0 < n ∧ x ^ n = 1 :=
begin
  cases n with n n,
  { rw zpow_of_nat at h,
    refine ⟨n, nat.pos_of_ne_zero (λ n0, hn _), h⟩, rw n0, refl },
  { rw [zpow_neg_succ_of_nat, inv_eq_one] at h,
    refine ⟨n + 1, n.succ_pos, h⟩ }
end

end group

section comm_group
variables {G : Type u} [comm_group G]

@[to_additive neg_add]
lemma mul_inv (a b : G) : (a * b)⁻¹ = a⁻¹ * b⁻¹ :=
by rw [mul_inv_rev, mul_comm]

@[to_additive]
lemma div_eq_of_eq_mul' {a b c : G} (h : a = b * c) : a / b = c :=
by rw [h, div_eq_mul_inv, mul_comm, inv_mul_cancel_left]

@[to_additive]
lemma div_mul_div_comm (a b c d : G) : a / b * (c / d) = a * c / (b * d) :=
by rw [div_eq_mul_inv, div_eq_mul_inv, div_eq_mul_inv, mul_inv_rev, mul_assoc, mul_assoc,
  mul_left_cancel_iff, mul_comm, mul_assoc]

variables {a b c d : G}

local attribute [simp] mul_assoc mul_comm mul_left_comm div_eq_mul_inv

@[to_additive]
lemma div_mul_eq_div_div (a b c : G) : a / (b * c) = a / b / c :=
by simp

@[to_additive]
lemma inv_mul_eq_div (a b : G) : a⁻¹ * b = b / a :=
by simp

@[to_additive sub_add_eq_add_sub]
lemma div_mul_eq_mul_div' (a b c : G) : a / b * c = a * c / b :=
by simp

@[to_additive]
lemma div_div (a b c : G) : a / b / c = a / (b * c) :=
by simp

@[to_additive]
lemma div_mul (a b c : G) : a / b * c = a / (b / c) :=
by simp

@[simp, to_additive]
lemma mul_div_mul_left_eq_div (a b c : G) : (c * a) / (c * b) = a / b :=
by simp

@[to_additive eq_sub_of_add_eq']
lemma eq_div_of_mul_eq'' (h : c * a = b) : a = b / c :=
by simp [h.symm]

@[to_additive]
lemma eq_mul_of_div_eq' (h : a / b = c) : a = b * c :=
by simp [h.symm]

@[to_additive]
lemma mul_eq_of_eq_div' (h : b = c / a) : a * b = c :=
begin simp [h], rw [mul_comm c, mul_inv_cancel_left] end

@[to_additive sub_sub_self]
lemma div_div_self' (a b : G) : a / (a / b) = b :=
by simpa using mul_inv_cancel_left a b

@[to_additive add_sub_comm]
lemma mul_div_comm' (a b c d : G) : a * b / (c * d) = (a / c) * (b / d) :=
by simp

@[to_additive]
lemma div_eq_div_mul_div (a b c : G) : a / b = c / b * (a / c) :=
begin simp, rw [mul_left_comm c], simp end

@[to_additive]
lemma inv_inv_div_inv (a b : G) : (a⁻¹ / b⁻¹)⁻¹ = a / b :=
by simp

@[simp, to_additive]
lemma div_div_cancel (a b : G) : a / (a / b) = b := div_div_self' a b

@[to_additive sub_eq_neg_add]
lemma div_eq_inv_mul' (a b : G) : a / b = b⁻¹ * a :=
by rw [div_eq_mul_inv, mul_comm _ _]

@[simp, to_additive]
lemma div_div_cancel_left (a b : G) : a / b / a = b⁻¹ := by simp

@[to_additive]
theorem inv_mul' (a b : G) : (a * b)⁻¹ = a⁻¹ / b :=
by rw [div_eq_mul_inv, mul_inv a b]

@[simp, to_additive]
lemma inv_div_inv (a b : G) : a⁻¹ / b⁻¹ = b / a :=
by simp [div_eq_inv_mul', mul_comm]

@[to_additive eq_sub_iff_add_eq']
lemma eq_div_iff_mul_eq'' : a = b / c ↔ c * a = b :=
by rw [eq_div_iff_mul_eq', mul_comm]

@[to_additive]
lemma div_eq_iff_eq_mul' : a / b = c ↔ a = b * c :=
by rw [div_eq_iff_eq_mul, mul_comm]

@[simp, to_additive add_sub_cancel']
lemma mul_div_cancel''' (a b : G) : a * b / a = b :=
by rw [div_eq_inv_mul', inv_mul_cancel_left]

@[simp, to_additive]
lemma mul_div_cancel'_right (a b : G) : a * (b / a) = b :=
by rw [← mul_div_assoc, mul_div_cancel''']

@[simp, to_additive sub_add_cancel']
lemma div_mul_cancel'' (a b : G) : a / (a * b) = b⁻¹ :=
by rw [← inv_div', mul_div_cancel''']

-- This lemma is in the `simp` set under the name `mul_inv_cancel_comm_assoc`,
-- along with the additive version `add_neg_cancel_comm_assoc`,
-- defined  in `algebra/group/commute`
@[to_additive]
lemma mul_mul_inv_cancel'_right (a b : G) : a * (b * a⁻¹) = b :=
by rw [← div_eq_mul_inv, mul_div_cancel'_right a b]

@[to_additive sub_right_comm]
lemma div_right_comm' (a b c : G) : a / b / c = a / c / b :=
by { repeat { rw div_eq_mul_inv }, exact mul_right_comm _ _ _ }

@[simp, to_additive]
lemma mul_mul_div_cancel (a b c : G) : (a * c) * (b / c) = a * b :=
by rw [mul_assoc, mul_div_cancel'_right]

@[simp, to_additive]
lemma div_mul_mul_cancel (a b c : G) : (a / c) * (b * c) = a * b :=
by rw [mul_left_comm, div_mul_cancel', mul_comm]

@[simp, to_additive sub_add_sub_cancel']
lemma div_mul_div_cancel'' (a b c : G) : (a / b) * (c / a) = c / b :=
by rw mul_comm; apply div_mul_div_cancel'

@[simp, to_additive]
lemma mul_div_div_cancel (a b c : G) : (a * b) / (a / c) = b * c :=
by rw [← div_mul, mul_div_cancel''']

@[simp, to_additive]
lemma div_div_div_cancel_left (a b c : G) : (c / a) / (c / b) = b / a :=
by rw [← inv_div' b c, div_inv_eq_mul, mul_comm, div_mul_div_cancel']

@[to_additive] lemma div_eq_div_iff_mul_eq_mul : a / b = c / d ↔ a * d = c * b :=
begin
  rw [div_eq_iff_eq_mul, div_mul_eq_mul_div', eq_comm, div_eq_iff_eq_mul'],
  simp only [mul_comm, eq_comm]
end

@[to_additive] lemma div_eq_div_iff_div_eq_div : a / b = c / d ↔ a / c = b / d :=
by rw [div_eq_iff_eq_mul, div_mul_eq_mul_div', div_eq_iff_eq_mul', mul_div_assoc]

end comm_group

section commutator

/-- The commutator of two elements `g₁` and `g₂`. -/
instance commutator_element {G : Type*} [group G] : has_bracket G G :=
⟨λ g₁ g₂, g₁ * g₂ * g₁⁻¹ * g₂⁻¹⟩

lemma commutator_element_def  {G : Type*} [group G] (g₁ g₂ : G) :
  ⁅g₁, g₂⁆ = g₁ * g₂ * g₁⁻¹ * g₂⁻¹ := rfl

end commutator


structure point (α : Type) :=
mk :: (x : α) (y : α)

#print point
#print prefix point

def point.smul (n : ℕ) (p : point ℕ) :=
point.mk (n * p.x) (n * p.y)

def p : point ℕ := point.mk 1 2

#reduce p.smul 3  -- {x := 3, y := 6}

#check { point . x := 10, y := 20 }  -- point ℕ
#check { point . y := 20, x := 10 }
#check ({x := 10, y := 20} : point _)

example : point _ := { y := 20, x := 10 }

structure my_struct :=
mk :: {α : Type} {β : Type} (a : α) (b : β)

#check { my_struct . a := 10, b := true }

#reduce {y := 3, ..p}  -- {x := 1, y := 3}
#reduce {x := 4, ..p}  -- {x := 4, y := 2}

structure point3 (α : Type) :=
mk :: (x : α) (y : α) (z : α)

def q : point3 nat :=
{x := 5, y := 5, z := 5}

def r : point3 nat := {x := 6, ..p, ..q}

#print r  -- {x := 6, y := p.y, z := q.z}
#reduce r  -- {x := 6, y := 2, z := 5}

inductive color
| red | green | blue

structure color_point (α : Type) extends point α :=
mk :: (c : color)

#print color_point
#print prefix color_point

structure rgb_val :=
(red : nat) (green : nat) (blue : nat)

structure red_green_point (α : Type) extends point3 α, rgb_val :=
(no_blue : blue = 0)

def p'   : point3 nat := {x := 10, y := 10, z := 20}
def rgp : red_green_point nat :=
{red := 200, green := 40, blue := 0, no_blue := rfl, ..p'}

example : rgp.x   = 10 := rfl
example : rgp.red = 200 := rfl

#print red_green_point


import analysis.normed.normed_field
import data.polynomial.taylor
import topology.metric_space.cau_seq_filter
import topology.algebra.polynomial

section nonarchimedean
  variables (𝕜 : Type) [normed_group 𝕜]

  /-- A type with a normed group structure is nonarchimedean if it satisfies `∥x + y∥ ≤ max ∥x∥ ∥y∥`. -/
  class nonarchimedean :=
  (nonarch : ∀ x y : 𝕜, ∥x + y∥ ≤ max (∥x∥) (∥y∥))

  variables {𝕜} [nonarchimedean 𝕜]

  /-- The nonarchimedean inequality with addition replaced with subtraction. -/
  theorem nonarchimedean.nonarch_sub (x y : 𝕜) : ∥x - y∥ ≤ max (∥x∥) (∥y∥) :=
    (sub_eq_add_neg x y).symm ▸ norm_neg y ▸ nonarchimedean.nonarch x (-y)

  /-- The nonarchimedean inequality is equal if the elements being added have different norms. -/
  theorem nonarchimedean.eq_max_of_ne_norm {x y : 𝕜} (h : ∥x∥ ≠ ∥y∥) :
    ∥x + y∥ = max (∥x∥) (∥y∥) :=
  begin
    have : ∀ {x y : 𝕜}, ∥x∥ > ∥y∥ → ∥x + y∥ = max (∥x∥) (∥y∥),
    { intros x y h,
      rw [max_eq_left_of_lt h],
      have := nonarchimedean.nonarch_sub (x + y) y,
      rw [←(eq_sub_of_add_eq rfl : x = x + y - y)] at this,
      apply le_antisymm (max_eq_left_of_lt h ▸ nonarchimedean.nonarch x y : ∥x + y∥ ≤ ∥x∥),
      cases le_max_iff.mp this with h' h',
      { exact h' },
      { exact absurd h' (not_le.mpr h) } },
    cases h.lt_or_lt with h h,
    { rw [add_comm, max_comm], exact this h },
    { exact this h }
  end

  /-- If the nonarchimedean inequality is not equal, the elements being added have the same norm. -/
  theorem nonarchimedean.eq_norm_of_ne_max {x y : 𝕜} (h : ∥x + y∥ ≠ max (∥x∥) (∥y∥)) :
    ∥x∥ = ∥y∥ := of_not_not (mt nonarchimedean.eq_max_of_ne_norm h)

  /-- A `ℕ`-indexed sequence in a nonarchimedean normed ring is Cauchy iff the difference
    of its consecutive terms tends to `0`. -/
  theorem nonarchimedean.cau {𝕜} [normed_ring 𝕜] [nonarchimedean 𝕜] {s : ℕ → 𝕜} :
    is_cau_seq norm s ↔ ∀ ε > 0, ∃ i, ∀ j ≥ i, ∥s (j + 1) - s j∥ < ε :=
  begin
    apply forall₂_congr, intros ε hε,
    split,
    { rintro ⟨i, hi⟩, use i, intros j hj,
      exact sub_add_sub_cancel (s (j + 1)) (s i) (s j) ▸ neg_sub (s j) (s i) ▸
        lt_of_le_of_lt (nonarchimedean.nonarch (s (j + 1) - s i) (-(s j - s i)))
        (max_lt (hi (j + 1) (le_add_right hj)) ((norm_neg (s j - s i)).symm ▸ hi j hj)) },
    { rintro ⟨i, hi⟩, use i, intros j hj,
      cases le_iff_exists_add.mp hj with k hk,
      induction k with k ih generalizing j,
      { rw [(add_zero i ▸ hk : j = i), sub_self, norm_zero], exact hε },
      { exact hk.symm ▸ (sub_add_sub_cancel (s (i + k + 1)) (s (i + k)) (s i)) ▸
          lt_of_le_of_lt (nonarchimedean.nonarch (s (i + k + 1) - s (i + k)) (s (i + k) - s i))
          (max_lt (hi (i + k) le_self_add) (ih (i + k) le_self_add rfl)) } }
  end
end nonarchimedean

section
  variables (𝕜 : Type) [normed_field 𝕜] [nonarchimedean 𝕜]

  /-- The closed unit ball in the nonarchimedean normed field `𝕜`. -/
  def disc : subring 𝕜 := {
    carrier   := {x | ∥x∥ ≤ 1},
    mul_mem'  := λ x y hx hy, (norm_mul_le x y).trans (one_mul (1 : ℝ) ▸
      mul_le_mul hx hy (norm_nonneg y) zero_le_one),
    one_mem'  := norm_one.le,
    add_mem'  := λ x y hx hy, (nonarchimedean.nonarch x y).trans (max_le hx hy),
    zero_mem' := norm_zero.le.trans zero_le_one,
    neg_mem'  := λ x hx, ((norm_neg x).symm ▸ hx : ∥-x∥ ≤ 1)
  }

  namespace disc
    /-- `disc 𝕜` inherits the norm of `𝕜`. -/
    instance disc_normed_ring : normed_ring (disc 𝕜) := {
      norm := norm ∘ subtype.val,
      dist_eq := λ x y, normed_field.dist_eq x.1 y.1 ▸ rfl,
      norm_mul := λ x y, le_of_eq (norm_mul x.1 y.1)
    }

    section
      variable {𝕜}

      /-- The norm of `disc 𝕜` equals the norm of the inclusion into `𝕜`. -/
      theorem norm_def (x : disc 𝕜) : ∥x∥ = ∥x.1∥ := rfl

      /-- All elements in `disc 𝕜` have norm less than or equal to `1`. -/
      theorem norm_le_one (x : disc 𝕜) : ∥x∥ ≤ 1 := x.2

      /-- The norm in `disc 𝕜` preserves multiplication. -/
      protected theorem norm_mul (x y : disc 𝕜) : ∥x * y∥ = ∥x∥ * ∥y∥ :=
        norm_mul x.1 y.1

      /-- The norm in `disc 𝕜` preserves exponentiation. -/
      protected theorem norm_pow (x : disc 𝕜) (n : ℕ) : ∥x ^ n∥ = ∥x∥ ^ n :=
        norm_pow x.1 n

      /-- Sequences with all elements having norm `≤ 1` are Cauchy in `𝕜` if and only if they are Cauchy in `disc 𝕜`. -/
      theorem disc_is_cau_seq_iff (s : ℕ → 𝕜) (hs : ∀ n, ∥s n∥ ≤ 1) :
        is_cau_seq norm s ↔ is_cau_seq norm (λ n, ⟨s n, hs n⟩ : ℕ → disc 𝕜) := iff.rfl

      /-- The injection of any Cauchy sequence in `disc 𝕜` into `𝕜` is also a Cauchy sequence. -/
      theorem disc_is_cau_seq {s : ℕ → disc 𝕜} (h : is_cau_seq norm s) : is_cau_seq norm (λ n, (s n).1) :=
        (disc_is_cau_seq_iff (λ n, (s n).1) (λ n, (s n).2)).mpr h

      variables {x y : disc 𝕜} (h : ∥x∥ ≤ ∥y∥)
      include h

      /-- `disc 𝕜` inherits division from `𝕜`, so long as the denominator has at least the numerator's norm. -/
      def divide : disc 𝕜 := ⟨x.1 / y.1,
      begin
        change ∥_∥ ≤ 1,
        rw [norm_div, ←norm_def x, ←norm_def y],
        by_cases hy : ∥y∥ = 0,
        { rw [hy, div_zero], exact zero_le_one },
        { exact (div_le_one (lt_of_le_of_ne (norm_nonneg y) (ne.symm hy))).mpr h }
      end⟩

      /-- The norm in `disc 𝕜` preserves division. -/
      theorem divide.norm : ∥divide h∥ = ∥x∥ / ∥y∥ :=
        norm_div x.1 y.1

      /-- If the denominator `y` is non-zero, multiplying `divide h` by `y` cancels the division, leaving the numerator `x`. -/
      theorem divide.mul_cancel (hy : y ≠ 0) : divide h * y = x :=
        subtype.val_inj.mp (div_mul_cancel x.1 (mt subtype.val_inj.mp hy : y.1 ≠ (0 : disc 𝕜).val))
    end

    /-- `disc 𝕜` inherits the nonarchimedean inequality from `𝕜`. -/
    instance disc_nonarchimedean : nonarchimedean (disc 𝕜) :=
      ⟨λ x y, (norm_def (x + y)).symm ▸ nonarchimedean.nonarch x.1 y.1⟩

    /-- The norm in `disc 𝕜` is an absolute value, thanks to properties inherited from the normed field `𝕜`. -/
    instance disc_norm_is_absolute_value : is_absolute_value (norm : disc 𝕜 → ℝ) := {
      abv_nonneg  := norm_nonneg,
      abv_eq_zero := λ _, norm_eq_zero,
      abv_add     := λ x y, (normed_field.is_absolute_value.abv_add : ∀ x y : 𝕜, ∥x + y∥ ≤ ∥x∥ + ∥y∥) x y,
      abv_mul     := disc.norm_mul,
    }

    /-- `disc 𝕜` inherits the completeness of `𝕜`, i.e. if all Cauchy sequences in `𝕜` are convergent,
      then so are all Cauchy sequences in `disc 𝕜`. -/
    instance disc_is_complete [cau_seq.is_complete 𝕜 norm] : cau_seq.is_complete (disc 𝕜) norm := ⟨λ s,
      begin
        let s' : cau_seq 𝕜 norm := ⟨λ n, (s n).1, s.2⟩,
        use s'.lim,
        { cases s'.equiv_lim 1 zero_lt_one with n hn,
          rw [←sub_add_cancel s'.lim (s' n)],
          apply le_trans (nonarchimedean.nonarch (s'.lim - s' n) (s' n)),
          have : ∥s' n - cau_seq.const norm s'.lim n∥ = ∥s'.lim - s' n∥,
          { rw [←norm_neg, neg_sub, cau_seq.const_apply] },
          exact max_le (this ▸ le_of_lt (hn n (le_refl n))) (s n).2 },
        { exact s'.equiv_lim }
      end⟩
  end disc
end

section taylor
  open polynomial
  variables {R : Type} [comm_ring R]

  /-- Any term of a polynomial sum can be removed and added separately so long as zero terms
    do not contribute to the sum. -/
  theorem polynomial.sum_term (n : ℕ) (f : polynomial R) (fn : ℕ → R → polynomial R) (h : ∀ k, fn k 0 = 0) :
    f.sum fn = fn n (f.coeff n) + (f.erase n).sum fn :=
  begin
    rw [sum_def, sum_def, support_erase],
    by_cases hn : n ∈ f.support,
    { rw [←finset.add_sum_erase f.support (λ n, fn n (f.coeff n)) hn],
      apply congr_arg, apply finset.sum_congr rfl, intros x hx,
      rw [erase_ne f n x (finset.ne_of_mem_erase hx)] },
    { rw [not_mem_support_iff.mp hn, h n, zero_add],
      exact eq.symm (finset.sum_congr (finset.erase_eq_of_not_mem hn)
        (λ x hx, congr_arg _ (erase_ne f n x (λ h, absurd (h ▸ hx : n ∈ f.support) hn)))) }
  end

  /-- Any polynomial `f` can be approximated as a quadratic polynomial centred on a chosen point `t₀`. -/
  theorem taylor₂ (f : polynomial R) (t₀ : R) : ∃ err : polynomial R, ∀ t,
    f.eval t = f.eval t₀ + (t - t₀) * f.derivative.eval t₀ + (t - t₀)^2 * err.eval t :=
  begin
    use (((taylor t₀ f).erase 0).erase 1).sum (λ i a, C a * (X - C t₀) ^ (i - 2)), intro t,
    have : ∀ n, C 0 * (X - C t₀) ^ n = 0, { intro n, rw [C_0, zero_mul] },
    conv_lhs { rw [←f.sum_taylor_eq t₀, (taylor t₀ f).sum_term 0 (λ i a, C a * (X - C t₀) ^ i) this,
      ((taylor t₀ f).erase 0).sum_term 1 (λ i a, C a * (X - C t₀) ^ i) this, taylor_coeff_zero,
      erase_ne (taylor t₀ f) 0 1 nat.one_ne_zero, taylor_coeff_one], simp only,
      rw [pow_zero, mul_one, pow_one, ←add_assoc, mul_comm, eval_add, eval_add,
        eval_C, eval_mul, eval_sub, eval_X, eval_C, eval_C] },
    apply congr_arg,
    have : (t - t₀)^2 = ((X - C t₀) ^ 2).eval t := by rw [eval_pow, eval_sub, eval_X, eval_C],
    rw [this, ←eval_mul], apply congr_arg,
    rw [sum_def, sum_def, finset.mul_sum, finset.sum_congr rfl],
    intros n hn,
    conv_rhs { rw [mul_comm, mul_assoc, ←pow_add], },
    have : 2 ≤ n,
    { cases n with n,
      { exfalso, rw [support_erase, support_erase, finset.erase_right_comm] at hn,
        exact absurd rfl (finset.ne_of_mem_erase hn) },
      { cases n with n, { rw [support_erase] at hn, exact absurd rfl (finset.ne_of_mem_erase hn) },
        { simp only [succ_order.succ_le_succ_iff, zero_le'] } } },
    rw [nat.sub_add_cancel this]
  end

  /-- Any polynomial `f` can be approximated as a linear polynomial centred on a chosen point `t₀`. -/
  theorem taylor₁ (f : polynomial R) (t₀ : R) : ∃ err : polynomial R, ∀ t,
    f.eval t = f.eval t₀ + (t - t₀) * err.eval t :=
  begin
    cases taylor₂ f t₀ with err h,
    use C (f.derivative.eval t₀) + (X - C t₀) * err, intro t,
    rw [h t, eval_add, eval_C, mul_add, ←add_assoc, eval_mul,
      eval_sub, eval_X, eval_C, ←mul_assoc, sq]
  end

end taylor

section
  variables {R : Type} [normed_ring R] [is_absolute_value (norm : R → ℝ)]

  /-- A filter-wise Cauchy sequence is an absolute-value-wise Cauchy sequence.
    (This already exists in `topology.metric_space.cau_seq_filter`, but only for normed fields,
    here it is restated for normed rings whose norm is an absolute value). -/
  theorem cauchy_seq.is_cau_seq' {f : ℕ → R} (hf : cauchy_seq f) :
    is_cau_seq norm f :=
  begin
    cases cauchy_iff.1 hf with hf1 hf2,
    intros ε hε,
    rcases hf2 {x | dist x.1 x.2 < ε} (metric.dist_mem_uniformity hε) with ⟨t, ⟨ht, htsub⟩⟩,
    simp at ht, cases ht with N hN,
    existsi N,
    intros j hj,
    rw ←dist_eq_norm,
    apply @htsub (f j, f N),
    apply set.mk_mem_prod; solve_by_elim [le_refl]
  end

  variable [cau_seq.is_complete R norm]

  /-- A Cauchy sequence formed by composing a Cauchy sequence with a polynomial. -/
  noncomputable def polynomial_comp (f : polynomial R) (s : cau_seq R norm) : cau_seq R norm :=
    ⟨λ n, f.eval (s n), ((f.continuous.tendsto s.lim).comp s.tendsto_limit).cauchy_seq.is_cau_seq'⟩

  /-- The composition of a polynomial with a Cauchy sequence's limit equals the limit of the
    composition of the polynomial with the Cauchy sequence. -/
  theorem polynomial_comp_lim (f : polynomial R) (s : cau_seq R norm) : f.eval s.lim = (polynomial_comp f s).lim :=
    tendsto_nhds_unique ((f.continuous.tendsto s.lim).comp s.tendsto_limit) (polynomial_comp f s).tendsto_limit

  /-- A Cauchy sequence formed by composing a Cauchy sequence with the norm. -/
  noncomputable def norm_comp (s : cau_seq R norm) : cau_seq ℝ norm :=
    ⟨λ n, ∥s n∥, ((continuous_norm.tendsto s.lim).comp s.tendsto_limit).cauchy_seq.is_cau_seq'⟩

  /-- The composition of the norm with a Cauchy sequence's limit equals the limit of the
    composition of the norm with the Cauchy sequence. -/
  theorem norm_comp_lim (s : cau_seq R norm) : ∥s.lim∥ = (norm_comp s).lim :=
    tendsto_nhds_unique ((continuous_norm.tendsto s.lim).comp s.tendsto_limit) (norm_comp s).tendsto_limit
end


example : ∀ n m, n + m = 1 → (n = 0 ∨ m = 0) := begin
    intros n,
    induction n,
    intros,
    simp,
    intros m,
    rw [nat.add_comm, nat.add_succ],
    intro a,
    have b : m + n_n = 0 := begin
        exact nat.succ_inj a
    end,
    right,
    exact (nat.eq_zero_of_add_eq_zero b).left
end


/-
This files provides the tactics
    hypo_analysis
    targets_analysis
which output a string reflecting the lean expr for objects in the
and in the target. The key function is analysis_expr_step that pattern
matches an object to determine a short string reflecting its node
(e.g., "INCLUSION"), and children (e.g. here, corresponding to the left
and righ hand side of the inclusion property).
The two tactics also provides the types of all intermediate objects.

Authors: Frédéric Le Roux
-/

import data.set
import data.real.basic
import tactic
import parser_analysis_definitions

import user_notations

namespace tactic.interactive
open lean.parser tactic interactive
open interactive (loc.ns)
open interactive.types
open tactic expr
local postfix *:9001 := many -- necessary for ident*

set_option pp.width 1000 -- We do not want CR inside our strings

def separator_object := "¿¿¿"
def separator_comma := "¿, "
def separator_equal := "¿= "
def separator_slash := "¿/ "
def open_paren := "¿("
def closed_paren := "¿)"
def open_bra := "¿["
def closed_bra := "¿]"

-- set_option trace.eqn_compiler.elim_match true

/- When e is a pi or lambda expr, instanciate e returns
a local constant a that stands for the first bound variable,
and the body of a with the free variable replaced by a.
The name of 'a' is enriched with suffix 'BoundVar'. -/
meta def instanciate (e : expr) : tactic (expr × expr) :=
match e with
| (pi pp_name binder type body) := do
    let pp_name := mk_str_name pp_name "BoundVar",
--    pp_name ← get_unused_name pp_name,      -- does not do the job
    -- trace ("Instantiation name: " ++ to_string pp_name),
    a ← mk_local' pp_name binder type,
    let inst_body := instantiate_var body a,
    return (a , inst_body)
| (lam pp_name binder type body) := do
    let pp_name := mk_str_name pp_name "BoundVar", -- trial
--    pp_name ← get_unused_name pp_name,
    -- trace ("Instantiation name: " ++ to_string pp_name),
    a ← mk_local' pp_name binder type,
    let inst_body := instantiate_var body a,
    return (a , inst_body)
| _ := return (e, e)
end

open set

/- The key function. Decompose the root of an expression (just one step)
General types should be at the end.
-/

private meta def analysis_expr_step  (e : expr) : tactic (string × (list expr)) :=
do  S ←  (tactic.pp e), let e_joli := to_string S,
match e with
------------------------- LOGIC -------------------------
| `(%%p ∧ %%q) := return ("PROP_AND", [p,q])
| `(%%p ∨ %%q) := return ("PROP_OR", [p,q])
| `(%%p ↔ %%q) := return ("PROP_IFF", [p,q])
-- various negations
| `(%%a ≠ %%b) := return ("PROP_EQUAL_NOT", [a,b])
| `(¬ %%a = %%b) := return ("PROP_EQUAL_NOT", [a,b])
| `(%%a ∉ %%A) := return ("PROP_NOT_BELONGS", [a,A])
| `(¬ %%p) := return ("PROP_NOT", [p])
| `(%%p → false)  := return ("PROP_NOT", [p])
| `(false) := return ("PROP_FALSE",[])
------------------------- SET THEORY -------------------------
| `(%%A ∩ %%B) := return ("SET_INTER", [A,B])
| `(%%A ∪ %%B) := return ("SET_UNION", [A,B])
| `(set.compl %%A) := do e_type ← infer_type e, match e_type with
    | `(_root_.set %%X) := return ("SET_COMPLEMENT", [X, A])
    | _ := return ("", [])
    end
-- | `(set.symmetric_difference %%A %%B) := return ("SET_DIFF_SYM", [A,B])
| `(%%A \ %%B) := return ("SET_DIFF", [A,B])
| `(%%A ⊆ %%B) := return ("PROP_INCLUDED", [A,B])
| `(%%a ∈ %%A) := return ("PROP_BELONGS", [a,A])
| `(@set.univ %%X) := return ("SET_UNIVERSE", [X])
| `(-%%A) := return ("MINUS", [A])
| `(set.Union %%A) := return ("SET_UNION+", [A])
| `(set.Inter %%A) := return ("SET_INTER+", [A])
| `(%%f '' %%A) := return ("SET_IMAGE", [f,A])
| `(%%f  ⁻¹' %%A) := return ("SET_INVERSE", [f,A])
| `(∅) := return ("SET_EMPTY", [])
| `({%%x, %%x', %%x''}) := return ("SET_EXTENSION3", [x, x', x''])
| `({%%x, %%x'}) := return ("SET_EXTENSION2", [x, x'])
| `({%%x}) := return ("SET_EXTENSION1", [x])
-- | `(triplet %%x %%x' %%x'') := return ("SET_EXTENSION3", [x, x', x''])
| `(pair %%x %%x') := return ("SET_EXTENSION2", [x, x'])
| `(sing %%x) := return ("SET_EXTENSION1", [x])
| `(_root_.set %%X) := return ("SET", [X])
| `(set.prod %%A %%B) := return ("SET_PRODUCT", [A, B])
| `(prod.mk %%x %%y) := return ("COUPLE", [x, y])
-- set in extension, e.g. A = {x | P x} or A = {x:X | P x} :
| `(@set_of %%X %%P) := match P with
    | (lam name binder type body) :=
            do (var_, inst_body) ← instanciate P,
                return ("SET_INTENSION",[X, var_, inst_body])
    | _ := return ("SET_INTENSION", [X, P])
    end
| `(index_set) := return ("TYPE", [])
| `(set_family %%I %%X) := return ("SET_FAMILY", [I, X])
-- | `(seq %%X) := return ("SEQUENCE", [X])
| (pi name binder type body) := do
    let is_arr := is_arrow e,
    if is_arr
        then do
            is_pro ← tactic.is_prop e,
            if is_pro
                then return ("PROP_IMPLIES", [type,body])
            else match e with
                | `(%%X → %%Y) := match (X,Y) with
                    -- | (`(ℕ), `(ℕ)) := return ("SEQUENCE", [X, Y])
                    -- | (`(ℕ), `(ℤ)) := return ("SEQUENCE", [X, Y])
                    -- | (`(ℕ), `(ℚ)) := return ("SEQUENCE", [X, Y])
                    -- | (`(ℕ), `(ℝ)) := return ("SEQUENCE", [X, Y])
                    | (`(ℕ), _) := return ("SEQUENCE", [X, Y])
                    | _ := do X_type ← infer_type X,
                        match (X_type, Y) with
                    -- A set family is when source is an index_set
                    -- (just a type which is "tagged" for serving as index)
                    -- and target is "set something"
                        | (`(index_set), `(_root_.set %%Z)) := return ("SET_FAMILY", [X, Z])
                        | _ := return ("FUNCTION", [X, Y])
                        end
                    end
                | _ := return ("ERROR", [])
                end
        else do
            (var_, inst_body) ← instanciate e,
            return ("QUANT_∀", [type, var_, inst_body])
| `(Exists %%p) := do match p with
    | (lam name binder type body) :=
            do (var_, inst_body) ← instanciate p,
                is_pro ← is_prop type,
                if is_pro
                    then return ("PROP_∃", [type, inst_body]) -- we do not care about var_
                    else return ("QUANT_∃", [type, var_, inst_body])
    |  _ := do p_type ← infer_type p, match p_type with
        | `(%%type → Prop) :=  do Q  ← to_expr ``(λ x: %%type,  (%%p x)), -- Do not work properly
                                (var_, inst_body) ← instanciate Q,
                                is_pro ← is_prop type,
                if is_pro
                    then return ("PROP_∃", [type, inst_body]) -- we do not care about var_
                    else return ("QUANT_∃", [type, var_, inst_body])
        | _ := return ("ERROR", [])
        end
    end
| `(exists_unique %%P) := do match P with
    | (lam name binder type body)   :=
            do (var_, inst_body) ← instanciate P,
            return ("QUANT_∃!", [type, var_, inst_body])
    |  _                            := return ("ERROR", [])
    end
-- polymorphic
| `(%%a = %%b) := return ("PROP_EQUAL", [a,b]) -- does not provide the type
----------- TOPOLOGY --------------
-- | `(B(%%x, %%r))
------------ ORDER ----------------
| `(%%a < %%b) := return ("PROP_<", [a,b])
| `(%%a ≤ %%b) := return ("PROP_≤", [a,b])
| `(%%a > %%b) := return ("PROP_>", [a,b])
| `(%%a ≥ %%b) := return ("PROP_≥", [a,b])
------------ ARITHMETIC ------------
| `(↑%%a)      := return ("COE", [a])
| `(%%a + %%b) := return ("SUM", [a, b])
| `(%%a - %%b) := return ("DIFFERENCE", [a, b])
| `(has_mul.mul %%a %%b) := return ("MULT", [a, b]) -- TODO: distinguish types/numbers
| `(%%a × %%b) := return ("PRODUCT", [a, b]) -- TODO: distinguish types/numbers
| `(%%a / %%b) := return ("DIV", [a, b])
| `(%%a ^ %%b) := return ("POWER", [a, b])
| `(real.sqrt %%a) := return ("SQRT", [a])
------------------------------ Leaves with data ---------------------------
| (app function argument)   :=
    if is_numeral e
        then return ("NUMBER" ++ open_bra ++ "value: " ++ e_joli ++ closed_bra, [])
        else return("APPLICATION", [function,argument])
-- | `(%%I → _root_.set %%X) := return ("SET_FAMILY", [I,X])
-- | `(ℝ) := return ("TYPE_NUMBER" ++ open_bra
--    ++ "name: ℝ" ++ closed_bra,[])
--| `(ℕ) := return ("TYPE_NUMBER"++ open_bra
--     ++ "name: ℕ" ++ closed_bra,[])
| (const name list_level)   :=
            return ("CONSTANT" ++ open_bra ++ "name: " ++ e_joli ++ closed_bra, [])
| (sort level.zero) := return ("PROP", [])
| (sort level) := return ("TYPE", [])
| (local_const name pretty_name bi type) :=
            return ("LOCAL_CONSTANT" ++ open_bra ++ "name: " ++ to_string pretty_name
            ++ separator_slash ++ "identifier: " ++ to_string name ++ closed_bra, [])
---------------- Other structures -------------
| (var nat)       :=
            return ("VAR" ++ open_bra ++ to_string nat ++ closed_bra, [])
| (mvar name pretty_name type)        :=
            return ("METAVAR" ++ open_bra ++ "name: " ++ to_string pretty_name ++ closed_bra, [])
| (elet name_var type_var expr body) :=
            return ("LET"++ open_bra ++ to_string name_var ++ closed_bra, [type_var,expr,body])
| (macro list something)       := return ("MACRO", [])
| (lam name binder type body)          :=
            do (var_, inst_body) ← instanciate e,
                return ("LAMBDA",[type, var_, inst_body])
end

/- Recursively analyses an expression using analysis_expr_step,
and provides a string with parentheses reflecting the mathematical object-/
private meta def analysis_rec : expr →  tactic string
| e :=
do ⟨string, list_expr⟩ ←  analysis_expr_step(e),
    match list_expr with
    -- BEWARE, case of more than three arguments not implemented
    -- replace by a list.map
    |[e1] :=  do
       string1 ← analysis_rec e1,
       return(string ++ open_paren ++ string1 ++ closed_paren)
    |[e1,e2] :=  do
        string1 ← analysis_rec e1,
        string2 ← analysis_rec e2,
        return (string ++ open_paren ++ string1 ++ separator_comma ++ string2 ++ closed_paren)
    |[e1,e2,e3] :=  do
        string1 ← analysis_rec e1,
        string2 ← analysis_rec e2,
        string3 ← analysis_rec e3,
        return (string ++ open_paren ++ string1 ++ separator_comma ++ string2 ++ separator_comma ++ string3 ++ closed_paren)
    | _ :=    return(string)
    end

meta def analysis_expr : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    is_pro ← is_prop expr_t,
    if is_pro then do
            S ←  (tactic.pp expr_t), let et_joli := to_string S,
            S1b ← analysis_rec e,
            S2 ← analysis_rec expr_t,
            let S3 := "PROPERTY" ++ open_bra ++ "identifier: " ++ S1b ++ separator_slash
                        ++ "pp_type: " ++ et_joli ++ closed_bra ++ separator_equal ++ S2,
            return(S3)
        else  do
            S1b ← analysis_rec e,
            S2 ← analysis_rec expr_t,
            let S3 := "OBJECT" ++ open_bra ++ S1b ++ closed_bra
                        ++ separator_equal ++ S2,
            return(S3)

/- Recursively analyses an expression using analysis_expr_step,
and provides a string with parentheses reflecting the mathematical object,
with types-/
private meta def analysis_rec_with_types : expr →  tactic string
| e :=
do ⟨string, list_expr⟩ ←  analysis_expr_step(e),
    -- trace ("analysing e: " ++ to_string e),
    -- if is_local_constant e
    --     then return(string)
    --     else do
        e_type ← infer_type e,
        -- trace "analysing e_type",
        string_type ← analysis_rec e_type,
        let str_with_type := string ++ open_bra ++ "type: " ++ string_type ++ closed_bra,
        -- trace str_with_type,
        match list_expr with
        -- BEWARE, case of more than three arguments not implemented
        -- replace by a list.map
            |[e1] :=  do
            string1 ← analysis_rec_with_types e1,
            return(str_with_type ++ open_paren ++ string1 ++ closed_paren)
            |[e1,e2] :=  do
                string1 ← analysis_rec_with_types e1,
                string2 ← analysis_rec_with_types e2,
                return (str_with_type ++ open_paren ++ string1 ++ separator_comma ++ string2 ++ closed_paren)
            |[e1,e2,e3] :=  do
                string1 ← analysis_rec_with_types e1,
                string2 ← analysis_rec_with_types e2,
                string3 ← analysis_rec_with_types e3,
                return (str_with_type ++ open_paren ++ string1 ++ separator_comma ++ string2 ++ separator_comma ++ string3 ++ closed_paren)
            | _ :=    return(str_with_type)
    end

-- set_option pp.all true
meta def analysis_expr_with_types : expr →  tactic string
| e :=
    do
    expr_t ←  infer_type e,
    is_pro ← is_prop expr_t,
    if is_pro then do
            S ←  (tactic.pp expr_t),
            --  insert something like
            -- (options := (options.set_nat pp.width 1000))
            -- in  let et_joli := to_string S,
            -- let et_joli := format.to_string (options.set_nat pp.width 1000) S,
            let et_joli := to_string S,
            S1b ← analysis_rec e,
            S2 ← analysis_rec_with_types expr_t,
            let S3 := separator_object ++ "property"
                ++ open_bra ++ "pp_type: " ++ et_joli ++ closed_bra
                ++ ": " ++ S1b ++ separator_equal ++ S2,
            return(S3)
        else  do
            S1b ← analysis_rec e,
            S2 ← analysis_rec expr_t,
            let S3 := separator_object ++ "object: " ++ S1b ++ separator_equal ++ S2,
            return(S3)

/- print a list of strings reflecting objects in the context  -/
meta def hypo_analysis : tactic unit :=
do list_expr ← local_context,
    trace "context:",
    list_expr.mmap (λ h, analysis_expr_with_types h >>= trace),
    return ()

/- print the list of all targets -/
meta def targets_analysis : tactic unit :=
do list_expr ← get_goals,
    trace "targets:",
    list_expr.mmap (λ h, analysis_expr_with_types h >>= trace),
    return ()

/---------------------------------------------------
----------------------------------------------------
----------------------------------------------------
--------------------- DEBUG ------------------------
----------------------------------------------------
----------------------------------------------------
----------------------------------------------------/

private meta def analyse_expr_step_brut  (e : expr) : tactic (string × (list expr)) :=
match e with
-- autres
| (pi name binder type body ) := return ("pi (nom : " ++ to_string name ++ ")",[type,body])
| (app fonction argument)   := return ("application", [fonction,argument])
| (const name list_level)   := return ("constante :" ++ to_string name, []) -- name → list level → expr
| (var nat)       := return ("var_"++ to_string nat, []) --  nat → expr
| (sort level)      := return ("sort", [])  -- level → expr
| (mvar name pretty_name type)        := return ("metavar", []) -- name → name → expr → expr
| (local_const name pretty_name bi type) := return ("constante_locale :" ++ to_string pretty_name, []) -- name → name → binder_info → expr → expr
| (lam name binder type body)          := return ("lambda (nom : " ++ to_string name ++ ")", [type,body]) -- name → binder_info → expr → expr → expr
| (elet name_var type_var expr body)        := return ("let", []) --name → expr → expr → expr → expr
| (macro liste pas_compris)       := return ("macro", []) -- macro_def → list expr → expr
end

private meta def analyse_rec_brut : expr →  tactic string
| e :=
do ⟨string, liste_expr⟩ ←  analyse_expr_step_brut e,
    match liste_expr with
    -- ATTENTION, cas de plus de trois arguiments non traité
    -- à remplacer par un list.map
    |[e1] :=  do
       string1 ← analyse_rec_brut e1,
       return(string ++ "(" ++ string1 ++ ")")
    |[e1,e2] :=  do
        string1 ← analyse_rec_brut e1,
        string2 ← analyse_rec_brut e2,
         return (string ++ "(" ++ string1 ++ "," ++ string2 ++ ")")
    |[e1,e2,e3] :=  do  -- non utilisé
        string1 ← analyse_rec_brut e1,
        string2 ← analyse_rec_brut e2,
        string3 ← analyse_rec_brut e3,
        return (string ++ "(" ++ string1 ++ "," ++ string2 ++ "," ++ string3 ++ ")")
    | _ :=    return(string)
    end

private meta def analyse_expr_brut : expr →  tactic string
| e := do
    expr_t ←  infer_type e,
    expr_tt ← infer_type expr_t,
    if expr_tt = `(Prop) then do
            S ←  (tactic.pp expr_t),
            let S1 := to_string S,
            S2 ← analyse_rec_brut expr_t,
            let S3 := "PROPRIETE : " ++ S1 ++ " : " ++ S2,
            return(S3)
        else  do let S0 := "OBJET : ",
            let S1 :=  to_string e,
            S2 ← analyse_rec_brut e,
            let S3 := S0 ++ S1 ++ " : "++ S2,
            return(S3)

/- Affiche la liste des objets du contexte, séparés par des retour chariots
format :  "OBJET" ou "PROPRIETE" : affichage Lean : structure -/
meta def analyse_contexte_brut : tactic unit :=
do liste_expr ← local_context,
    trace "Contexte :",
    liste_expr.mmap (λ h, analyse_expr_brut h >>= trace),
    return ()

/- Analyse brute de Lean (dans expr) -/
meta def analyse_raw (names : parse ident*) : tactic unit :=
match names with
    | [] := do goal ← tactic.target,
                trace $ to_raw_fmt goal
    | [nom] := do expr ← get_local nom,
                expr_t ←  infer_type expr,
                trace $ to_raw_fmt expr_t
    | _ := skip
    end

end tactic.interactive

-- example (X Y: Type) (f: set X → set X) (I: set.index_set) (E: I → set X)
-- (F: I → X) (G: I → set (X × Y)) (H: Y → set X):
-- true :=
-- begin
--     hypo_analysis,
-- end


import .simplify_eq
import galois.list
import galois.nat

namespace bitvec

-- Unsigned extension
def uext {m :ℕ } (x:bitvec m) (n:ℕ) (pr : m ≤ n) : bitvec n :=
  let q : n - m + m = n := nat.sub_add_cancel pr in
  bitvec.cong q (bitvec.append (bitvec.zero (n-m)) x)

-- Return all bitvectors with a given size.
def all : Π(k:ℕ), list (bitvec k)
| 0 := [bitvec.zero 0]
| (nat.succ k)
   := list.map (vector.cons ff) (all k)
   ++ list.map (vector.cons tt) (all k)

protected def to_string {n : nat} (x : bitvec n) : string := has_to_string.to_string x.to_nat

instance (n : nat) : has_to_string (bitvec n) := ⟨bitvec.to_string⟩

-- Return the maximum unsigned number.
def max_unsigned : ℕ → ℕ
| 0 := 0
| (nat.succ x) := 2 * max_unsigned x + 1

-- Lemma about upper bounds of bits_to_nat
lemma bits_to_nat_upper_bound (v : list bool) : bits_to_nat v ≤ max_unsigned (list.length v) :=
-- Show 'cond e 1 0' is at most 1.
let cond_le : Π (e : bool), cond e 1 0 ≤ 1 := λe,
      match e with
      | bool.tt := nat.le_refl _
      | bool.ff := nat.zero_le _
      end in
begin
  unfold bits_to_nat,
  -- Induct over the structure of foldl
  apply (list.foldl_rec (λl r, r ≤ max_unsigned (list.length l))),
  { intros l t e p,
    unfold add_lsb,
    -- Replace cond e 1 0 with 1
    transitivity,
    {  apply add_le_add_left,
       apply (cond_le e)
    },
    -- Simplify to recursive case
    simp [nat.add_succ, max_unsigned, add_lsb, nat.mul_succ],
    apply nat.succ_le_succ,
    apply nat.add_le_add_both,
    all_goals { exact p },
  },
  { exact dec_trivial,
  }
end

-- Upper bounds of bitvec.to_nat
theorem to_nat_upper_bound {n : ℕ} : ∀(x : bitvec n), bitvec.to_nat x ≤ max_unsigned n
| ⟨ x, p ⟩ :=
begin
  simp [eq.symm p],
  apply bitvec.bits_to_nat_upper_bound
end

-- Show that prepending zero to a number does not change it.
theorem to_nat_append_zero  (m : ℕ) {n : ℕ} (k : bitvec n)
: bitvec.to_nat (bitvec.append (0 : bitvec m) k) = bitvec.to_nat k :=
begin
  cases k,
  induction m with m ind,
  refl,
  {
    revert ind,
    simp [ bitvec.zero, bitvec.append],
    simp [vector.repeat, vector.append, bitvec.to_nat],
    simp [ bits_to_nat, list.foldl, add_lsb],
    exact id,
  }
end

end bitvec