/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Andreas Swerdlow
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.matrix
import Mathlib.linear_algebra.tensor_product
import Mathlib.linear_algebra.nonsingular_inverse
import Mathlib.PostPort

universes u v l u_1 w u_2 u_3 u_4 u_5

namespace Mathlib

/-!
# Bilinear form

This file defines a bilinear form over a module. Basic ideas
such as orthogonality are also introduced, as well as reflexivive,
symmetric and alternating bilinear forms. Adjoints of linear maps
with respect to a bilinear form are also introduced.

A bilinear form on an R-(semi)module M, is a function from M x M to R,
that is linear in both arguments. Comments will typically abbreviate
"(semi)module" as just "module", but the definitions should be as general as
possible.

## Notations

Given any term B of type bilin_form, due to a coercion, can use
the notation B x y to refer to the function field, ie. B x y = B.bilin x y.

In this file we use the following type variables:
 - `M`, `M'`, ... are semimodules over the semiring `R`,
 - `M₁`, `M₁'`, ... are modules over the ring `R₁`,
 - `M₂`, `M₂'`, ... are semimodules over the commutative semiring `R₂`
 - `M₃`, `M₃'`, ... are modules over the commutative ring `R₃`

## References

* <https://en.wikipedia.org/wiki/Bilinear_form>

## Tags

Bilinear form,
-/

/-- `bilin_form R M` is the type of `R`-bilinear functions `M → M → R`. -/
structure bilin_form (R : Type u) (M : Type v) [semiring R] [add_comm_monoid M] [semimodule R M]
    where
  bilin : M → M → R
  bilin_add_left : ∀ (x y z : M), bilin (x + y) z = bilin x z + bilin y z
  bilin_smul_left : ∀ (a : R) (x y : M), bilin (a • x) y = a * bilin x y
  bilin_add_right : ∀ (x y z : M), bilin x (y + z) = bilin x y + bilin x z
  bilin_smul_right : ∀ (a : R) (x y : M), bilin x (a • y) = a * bilin x y

namespace bilin_form

protected instance has_coe_to_fun {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] : has_coe_to_fun (bilin_form R M) :=
  has_coe_to_fun.mk (fun (B : bilin_form R M) => M → M → R) fun (B : bilin_form R M) => bilin B

@[simp] theorem coe_fn_mk {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] (f : M → M → R) (h₁ : ∀ (x y z : M), f (x + y) z = f x z + f y z)
    (h₂ : ∀ (a : R) (x y : M), f (a • x) y = a * f x y)
    (h₃ : ∀ (x y z : M), f x (y + z) = f x y + f x z)
    (h₄ : ∀ (a : R) (x y : M), f x (a • y) = a * f x y) : ⇑(mk f h₁ h₂ h₃ h₄) = f :=
  rfl

theorem coe_fn_congr {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} {x : M} {x' : M} {y : M} {y' : M} :
    x = x' → y = y' → coe_fn B x y = coe_fn B x' y' :=
  sorry

@[simp] theorem add_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} (x : M) (y : M) (z : M) :
    coe_fn B (x + y) z = coe_fn B x z + coe_fn B y z :=
  bilin_add_left B x y z

@[simp] theorem smul_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} (a : R) (x : M) (y : M) :
    coe_fn B (a • x) y = a * coe_fn B x y :=
  bilin_smul_left B a x y

@[simp] theorem add_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} (x : M) (y : M) (z : M) :
    coe_fn B x (y + z) = coe_fn B x y + coe_fn B x z :=
  bilin_add_right B x y z

@[simp] theorem smul_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} (a : R) (x : M) (y : M) :
    coe_fn B x (a • y) = a * coe_fn B x y :=
  bilin_smul_right B a x y

@[simp] theorem zero_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} (x : M) : coe_fn B 0 x = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn B 0 x = 0)) (Eq.symm (zero_smul R 0))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn B (0 • 0) x = 0)) (smul_left 0 0 x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 * coe_fn B 0 x = 0)) (zero_mul (coe_fn B 0 x))))
        (Eq.refl 0)))

@[simp] theorem zero_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} (x : M) : coe_fn B x 0 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn B x 0 = 0)) (Eq.symm (zero_smul R 0))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn B x (0 • 0) = 0)) (smul_right 0 x 0)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 * coe_fn B x 0 = 0)) (zero_mul (coe_fn B x 0))))
        (Eq.refl 0)))

@[simp] theorem neg_left {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁]
    {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) : coe_fn B₁ (-x) y = -coe_fn B₁ x y :=
  sorry

@[simp] theorem neg_right {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁]
    {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) : coe_fn B₁ x (-y) = -coe_fn B₁ x y :=
  sorry

@[simp] theorem sub_left {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁]
    {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) (z : M₁) :
    coe_fn B₁ (x - y) z = coe_fn B₁ x z - coe_fn B₁ y z :=
  sorry

@[simp] theorem sub_right {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁]
    {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) (z : M₁) :
    coe_fn B₁ x (y - z) = coe_fn B₁ x y - coe_fn B₁ x z :=
  sorry

theorem ext {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} {D : bilin_form R M} (H : ∀ (x y : M), coe_fn B x y = coe_fn D x y) :
    B = D :=
  sorry

protected instance add_comm_monoid {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] : add_comm_monoid (bilin_form R M) :=
  add_comm_monoid.mk
    (fun (B D : bilin_form R M) =>
      mk (fun (x y : M) => coe_fn B x y + coe_fn D x y) sorry sorry sorry sorry)
    sorry (mk (fun (x y : M) => 0) sorry sorry sorry sorry) sorry sorry sorry

protected instance add_comm_group {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁]
    [module R₁ M₁] : add_comm_group (bilin_form R₁ M₁) :=
  add_comm_group.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry
    (fun (B : bilin_form R₁ M₁) => mk (fun (x y : M₁) => -bilin B x y) sorry sorry sorry sorry)
    (add_group.sub._default add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry
      fun (B : bilin_form R₁ M₁) => mk (fun (x y : M₁) => -bilin B x y) sorry sorry sorry sorry)
    sorry sorry

@[simp] theorem add_apply {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} {D : bilin_form R M} (x : M) (y : M) :
    coe_fn (B + D) x y = coe_fn B x y + coe_fn D x y :=
  rfl

@[simp] theorem neg_apply {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁]
    {B₁ : bilin_form R₁ M₁} (x : M₁) (y : M₁) : coe_fn (-B₁) x y = -coe_fn B₁ x y :=
  rfl

protected instance inhabited {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] : Inhabited (bilin_form R M) :=
  { default := 0 }

protected instance semimodule {M : Type v} [add_comm_monoid M] {R : Type u_1} [comm_semiring R]
    [semimodule R M] : semimodule R (bilin_form R M) :=
  semimodule.mk sorry sorry

@[simp] theorem smul_apply {M : Type v} [add_comm_monoid M] {R : Type u_1} [comm_semiring R]
    [semimodule R M] (B : bilin_form R M) (a : R) (x : M) (y : M) :
    coe_fn (a • B) x y = a • coe_fn B x y :=
  rfl

end bilin_form

/-- A map with two arguments that is linear in both is a bilinear form.

This is an auxiliary definition for the full linear equivalence `linear_map.to_bilin`.
-/
def linear_map.to_bilin_aux {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] (f : linear_map R₂ M₂ (linear_map R₂ M₂ R₂)) : bilin_form R₂ M₂ :=
  bilin_form.mk (fun (x y : M₂) => coe_fn (coe_fn f x) y) sorry sorry sorry sorry

/-- A map with two arguments that is linear in both is linearly equivalent to bilinear form. -/
def linear_map.to_bilin {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] :
    linear_equiv R₂ (linear_map R₂ M₂ (linear_map R₂ M₂ R₂)) (bilin_form R₂ M₂) :=
  linear_equiv.mk linear_map.to_bilin_aux sorry sorry
    (fun (F : bilin_form R₂ M₂) => linear_map.mk₂ R₂ ⇑F sorry sorry sorry sorry) sorry sorry

/-- Bilinear forms are linearly equivalent to maps with two arguments that are linear in both. -/
def bilin_form.to_lin {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] :
    linear_equiv R₂ (bilin_form R₂ M₂) (linear_map R₂ M₂ (linear_map R₂ M₂ R₂)) :=
  linear_equiv.symm linear_map.to_bilin

@[simp] theorem linear_map.to_bilin_aux_eq {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] (f : linear_map R₂ M₂ (linear_map R₂ M₂ R₂)) :
    linear_map.to_bilin_aux f = coe_fn linear_map.to_bilin f :=
  rfl

@[simp] theorem linear_map.to_bilin_symm {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] :
    linear_equiv.symm linear_map.to_bilin = bilin_form.to_lin :=
  rfl

@[simp] theorem bilin_form.to_lin_symm {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] :
    linear_equiv.symm bilin_form.to_lin = linear_map.to_bilin :=
  linear_equiv.symm_symm linear_map.to_bilin

@[simp] theorem to_linear_map_apply {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] {B₂ : bilin_form R₂ M₂} (x : M₂) :
    ⇑(coe_fn (coe_fn bilin_form.to_lin B₂) x) = coe_fn B₂ x :=
  rfl

@[simp] theorem map_sum_left {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] {B₂ : bilin_form R₂ M₂} {α : Type u_1} (t : finset α) (g : α → M₂) (w : M₂) :
    coe_fn B₂ (finset.sum t fun (i : α) => g i) w = finset.sum t fun (i : α) => coe_fn B₂ (g i) w :=
  sorry

@[simp] theorem map_sum_right {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] {B₂ : bilin_form R₂ M₂} {α : Type u_1} (t : finset α) (w : M₂) (g : α → M₂) :
    coe_fn B₂ w (finset.sum t fun (i : α) => g i) = finset.sum t fun (i : α) => coe_fn B₂ w (g i) :=
  sorry

namespace bilin_form

/-- Apply a linear map on the left and right argument of a bilinear form. -/
def comp {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {M' : Type w}
    [add_comm_monoid M'] [semimodule R M'] (B : bilin_form R M') (l : linear_map R M M')
    (r : linear_map R M M') : bilin_form R M :=
  mk (fun (x y : M) => coe_fn B (coe_fn l x) (coe_fn r y)) sorry sorry sorry sorry

/-- Apply a linear map to the left argument of a bilinear form. -/
def comp_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    (B : bilin_form R M) (f : linear_map R M M) : bilin_form R M :=
  comp B f linear_map.id

/-- Apply a linear map to the right argument of a bilinear form. -/
def comp_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    (B : bilin_form R M) (f : linear_map R M M) : bilin_form R M :=
  comp B linear_map.id f

theorem comp_comp {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {M' : Type w} [add_comm_monoid M'] [semimodule R M'] {M'' : Type u_1} [add_comm_monoid M'']
    [semimodule R M''] (B : bilin_form R M'') (l : linear_map R M M') (r : linear_map R M M')
    (l' : linear_map R M' M'') (r' : linear_map R M' M'') :
    comp (comp B l' r') l r = comp B (linear_map.comp l' l) (linear_map.comp r' r) :=
  rfl

@[simp] theorem comp_left_comp_right {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] (B : bilin_form R M) (l : linear_map R M M) (r : linear_map R M M) :
    comp_right (comp_left B l) r = comp B l r :=
  rfl

@[simp] theorem comp_right_comp_left {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] (B : bilin_form R M) (l : linear_map R M M) (r : linear_map R M M) :
    comp_left (comp_right B r) l = comp B l r :=
  rfl

@[simp] theorem comp_apply {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {M' : Type w} [add_comm_monoid M'] [semimodule R M'] (B : bilin_form R M')
    (l : linear_map R M M') (r : linear_map R M M') (v : M) (w : M) :
    coe_fn (comp B l r) v w = coe_fn B (coe_fn l v) (coe_fn r w) :=
  rfl

@[simp] theorem comp_left_apply {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] (B : bilin_form R M) (f : linear_map R M M) (v : M) (w : M) :
    coe_fn (comp_left B f) v w = coe_fn B (coe_fn f v) w :=
  rfl

@[simp] theorem comp_right_apply {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] (B : bilin_form R M) (f : linear_map R M M) (v : M) (w : M) :
    coe_fn (comp_right B f) v w = coe_fn B v (coe_fn f w) :=
  rfl

theorem comp_injective {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {M' : Type w} [add_comm_monoid M'] [semimodule R M'] (B₁ : bilin_form R M')
    (B₂ : bilin_form R M') (l : linear_map R M M') (r : linear_map R M M')
    (hₗ : function.surjective ⇑l) (hᵣ : function.surjective ⇑r) :
    comp B₁ l r = comp B₂ l r ↔ B₁ = B₂ :=
  sorry

/-- Apply a linear equivalence on the arguments of a bilinear form. -/
def congr {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂] [semimodule R₂ M₂]
    {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂'] (e : linear_equiv R₂ M₂ M₂') :
    linear_equiv R₂ (bilin_form R₂ M₂) (bilin_form R₂ M₂') :=
  linear_equiv.mk
    (fun (B : bilin_form R₂ M₂) => comp B ↑(linear_equiv.symm e) ↑(linear_equiv.symm e)) sorry sorry
    (fun (B : bilin_form R₂ M₂') => comp B ↑e ↑e) sorry sorry

@[simp] theorem congr_apply {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂']
    (e : linear_equiv R₂ M₂ M₂') (B : bilin_form R₂ M₂) (x : M₂') (y : M₂') :
    coe_fn (coe_fn (congr e) B) x y =
        coe_fn B (coe_fn (linear_equiv.symm e) x) (coe_fn (linear_equiv.symm e) y) :=
  rfl

@[simp] theorem congr_symm {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂']
    (e : linear_equiv R₂ M₂ M₂') : linear_equiv.symm (congr e) = congr (linear_equiv.symm e) :=
  sorry

theorem congr_comp {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂'] {M₂'' : Type u_2}
    [add_comm_monoid M₂''] [semimodule R₂ M₂''] (e : linear_equiv R₂ M₂ M₂') (B : bilin_form R₂ M₂)
    (l : linear_map R₂ M₂'' M₂') (r : linear_map R₂ M₂'' M₂') :
    comp (coe_fn (congr e) B) l r =
        comp B (linear_map.comp (↑(linear_equiv.symm e)) l)
          (linear_map.comp (↑(linear_equiv.symm e)) r) :=
  rfl

theorem comp_congr {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂'] {M₂'' : Type u_2}
    [add_comm_monoid M₂''] [semimodule R₂ M₂''] (e : linear_equiv R₂ M₂' M₂'')
    (B : bilin_form R₂ M₂) (l : linear_map R₂ M₂' M₂) (r : linear_map R₂ M₂' M₂) :
    coe_fn (congr e) (comp B l r) =
        comp B (linear_map.comp l ↑(linear_equiv.symm e))
          (linear_map.comp r ↑(linear_equiv.symm e)) :=
  rfl

/-- `lin_mul_lin f g` is the bilinear form mapping `x` and `y` to `f x * g y` -/
def lin_mul_lin {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] (f : linear_map R₂ M₂ R₂) (g : linear_map R₂ M₂ R₂) : bilin_form R₂ M₂ :=
  mk (fun (x y : M₂) => coe_fn f x * coe_fn g y) sorry sorry sorry sorry

@[simp] theorem lin_mul_lin_apply {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] {f : linear_map R₂ M₂ R₂} {g : linear_map R₂ M₂ R₂}
    (x : M₂) (y : M₂) : coe_fn (lin_mul_lin f g) x y = coe_fn f x * coe_fn g y :=
  rfl

@[simp] theorem lin_mul_lin_comp {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] {M₂' : Type u_1} [add_comm_monoid M₂'] [semimodule R₂ M₂']
    {f : linear_map R₂ M₂ R₂} {g : linear_map R₂ M₂ R₂} (l : linear_map R₂ M₂' M₂)
    (r : linear_map R₂ M₂' M₂) :
    comp (lin_mul_lin f g) l r = lin_mul_lin (linear_map.comp f l) (linear_map.comp g r) :=
  rfl

@[simp] theorem lin_mul_lin_comp_left {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] {f : linear_map R₂ M₂ R₂} {g : linear_map R₂ M₂ R₂}
    (l : linear_map R₂ M₂ M₂) :
    comp_left (lin_mul_lin f g) l = lin_mul_lin (linear_map.comp f l) g :=
  rfl

@[simp] theorem lin_mul_lin_comp_right {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] {f : linear_map R₂ M₂ R₂} {g : linear_map R₂ M₂ R₂}
    (r : linear_map R₂ M₂ M₂) :
    comp_right (lin_mul_lin f g) r = lin_mul_lin f (linear_map.comp g r) :=
  rfl

/-- The proposition that two elements of a bilinear form space are orthogonal -/
def is_ortho {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    (B : bilin_form R M) (x : M) (y : M) :=
  coe_fn B x y = 0

theorem ortho_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} (x : M) : is_ortho B 0 x :=
  zero_left x

@[simp] theorem is_ortho_smul_left {R₄ : Type u_2} {M₄ : Type u_3} [domain R₄] [add_comm_group M₄]
    [module R₄ M₄] {G : bilin_form R₄ M₄} {x : M₄} {y : M₄} {a : R₄} (ha : a ≠ 0) :
    is_ortho G (a • x) y ↔ is_ortho G x y :=
  sorry

@[simp] theorem is_ortho_smul_right {R₄ : Type u_2} {M₄ : Type u_3} [domain R₄] [add_comm_group M₄]
    [module R₄ M₄] {G : bilin_form R₄ M₄} {x : M₄} {y : M₄} {a : R₄} (ha : a ≠ 0) :
    is_ortho G x (a • y) ↔ is_ortho G x y :=
  sorry

/-- Two bilinear forms are equal when they are equal on all basis vectors. -/
theorem ext_basis {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃]
    {B₃ : bilin_form R₃ M₃} {F₃ : bilin_form R₃ M₃} {ι : Type u_2} {b : ι → M₃} (hb : is_basis R₃ b)
    (h : ∀ (i j : ι), coe_fn B₃ (b i) (b j) = coe_fn F₃ (b i) (b j)) : B₃ = F₃ :=
  linear_equiv.injective to_lin
    (is_basis.ext hb fun (i : ι) => is_basis.ext hb fun (j : ι) => h i j)

/-- Write out `B x y` as a sum over `B (b i) (b j)` if `b` is a basis. -/
theorem sum_repr_mul_repr_mul {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {B₃ : bilin_form R₃ M₃} {ι : Type u_2} {b : ι → M₃} (hb : is_basis R₃ b) (x : M₃)
    (y : M₃) :
    (finsupp.sum (coe_fn (is_basis.repr hb) x)
          fun (i : ι) (xi : R₃) =>
            finsupp.sum (coe_fn (is_basis.repr hb) y)
              fun (j : ι) (yj : R₃) => xi • yj • coe_fn B₃ (b i) (b j)) =
        coe_fn B₃ x y :=
  sorry

end bilin_form

/-- The map from `matrix n n R` to bilinear forms on `n → R`.

This is an auxiliary definition for the equivalence `matrix.to_bilin_form'`. -/
def matrix.to_bilin'_aux {R₂ : Type u} [comm_semiring R₂] {n : Type u_1} [fintype n]
    (M : matrix n n R₂) : bilin_form R₂ (n → R₂) :=
  bilin_form.mk
    (fun (v w : n → R₂) =>
      finset.sum finset.univ fun (i : n) => finset.sum finset.univ fun (j : n) => v i * M i j * w j)
    sorry sorry sorry sorry

theorem matrix.to_bilin'_aux_std_basis {R₂ : Type u} [comm_semiring R₂] {n : Type u_1} [fintype n]
    [DecidableEq n] (M : matrix n n R₂) (i : n) (j : n) :
    coe_fn (matrix.to_bilin'_aux M) (coe_fn (linear_map.std_basis R₂ (fun (ᾰ : n) => R₂) i) 1)
          (coe_fn (linear_map.std_basis R₂ (fun (ᾰ : n) => R₂) j) 1) =
        M i j :=
  sorry

/-- The linear map from bilinear forms to `matrix n n R` given an `n`-indexed basis.

This is an auxiliary definition for the equivalence `matrix.to_bilin_form'`. -/
def bilin_form.to_matrix_aux {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] {n : Type u_1} [fintype n] (b : n → M₂) :
    linear_map R₂ (bilin_form R₂ M₂) (matrix n n R₂) :=
  linear_map.mk (fun (B : bilin_form R₂ M₂) (i j : n) => coe_fn B (b i) (b j)) sorry sorry

theorem to_bilin'_aux_to_matrix_aux {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (B₃ : bilin_form R₃ (n → R₃)) :
    matrix.to_bilin'_aux
          (coe_fn
            (bilin_form.to_matrix_aux
              fun (j : n) => coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1)
            B₃) =
        B₃ :=
  sorry

/-! ### `to_matrix'` section

This section deals with the conversion between matrices and bilinear forms on `n → R₃`.
-/

/-- The linear equivalence between bilinear forms on `n → R` and `n × n` matrices -/
def bilin_form.to_matrix' {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] :
    linear_equiv R₃ (bilin_form R₃ (n → R₃)) (matrix n n R₃) :=
  linear_equiv.mk
    (linear_map.to_fun
      (bilin_form.to_matrix_aux
        fun (j : n) => coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1))
    sorry sorry matrix.to_bilin'_aux sorry sorry

@[simp] theorem bilin_form.to_matrix_aux_std_basis {R₃ : Type u} [comm_ring R₃] {n : Type u_1}
    [fintype n] [DecidableEq n] (B : bilin_form R₃ (n → R₃)) :
    coe_fn
          (bilin_form.to_matrix_aux
            fun (j : n) => coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1)
          B =
        coe_fn bilin_form.to_matrix' B :=
  rfl

/-- The linear equivalence between `n × n` matrices and bilinear forms on `n → R` -/
def matrix.to_bilin' {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n] [DecidableEq n] :
    linear_equiv R₃ (matrix n n R₃) (bilin_form R₃ (n → R₃)) :=
  linear_equiv.symm bilin_form.to_matrix'

@[simp] theorem matrix.to_bilin'_aux_eq {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (M : matrix n n R₃) : matrix.to_bilin'_aux M = coe_fn matrix.to_bilin' M :=
  rfl

theorem matrix.to_bilin'_apply {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (M : matrix n n R₃) (x : n → R₃) (y : n → R₃) :
    coe_fn (coe_fn matrix.to_bilin' M) x y =
        finset.sum finset.univ
          fun (i : n) => finset.sum finset.univ fun (j : n) => x i * M i j * y j :=
  rfl

@[simp] theorem matrix.to_bilin'_std_basis {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (M : matrix n n R₃) (i : n) (j : n) :
    coe_fn (coe_fn matrix.to_bilin' M) (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) i) 1)
          (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1) =
        M i j :=
  matrix.to_bilin'_aux_std_basis M i j

@[simp] theorem bilin_form.to_matrix'_symm {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] : linear_equiv.symm bilin_form.to_matrix' = matrix.to_bilin' :=
  rfl

@[simp] theorem matrix.to_bilin'_symm {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] : linear_equiv.symm matrix.to_bilin' = bilin_form.to_matrix' :=
  linear_equiv.symm_symm bilin_form.to_matrix'

@[simp] theorem matrix.to_bilin'_to_matrix' {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (B : bilin_form R₃ (n → R₃)) :
    coe_fn matrix.to_bilin' (coe_fn bilin_form.to_matrix' B) = B :=
  linear_equiv.apply_symm_apply matrix.to_bilin' B

@[simp] theorem bilin_form.to_matrix'_to_bilin' {R₃ : Type u} [comm_ring R₃] {n : Type u_1}
    [fintype n] [DecidableEq n] (M : matrix n n R₃) :
    coe_fn bilin_form.to_matrix' (coe_fn matrix.to_bilin' M) = M :=
  linear_equiv.apply_symm_apply bilin_form.to_matrix' M

@[simp] theorem bilin_form.to_matrix'_apply {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (i : n) (j : n) :
    coe_fn bilin_form.to_matrix' B i j =
        coe_fn B (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) i) 1)
          (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) j) 1) :=
  rfl

@[simp] theorem bilin_form.to_matrix'_comp {R₃ : Type u} [comm_ring R₃] {n : Type u_1}
    {o : Type u_2} [fintype n] [fintype o] [DecidableEq n] [DecidableEq o]
    (B : bilin_form R₃ (n → R₃)) (l : linear_map R₃ (o → R₃) (n → R₃))
    (r : linear_map R₃ (o → R₃) (n → R₃)) :
    coe_fn bilin_form.to_matrix' (bilin_form.comp B l r) =
        matrix.mul
          (matrix.mul (matrix.transpose (coe_fn linear_map.to_matrix' l))
            (coe_fn bilin_form.to_matrix' B))
          (coe_fn linear_map.to_matrix' r) :=
  sorry

theorem bilin_form.to_matrix'_comp_left {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (f : linear_map R₃ (n → R₃) (n → R₃)) :
    coe_fn bilin_form.to_matrix' (bilin_form.comp_left B f) =
        matrix.mul (matrix.transpose (coe_fn linear_map.to_matrix' f))
          (coe_fn bilin_form.to_matrix' B) :=
  sorry

theorem bilin_form.to_matrix'_comp_right {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (f : linear_map R₃ (n → R₃) (n → R₃)) :
    coe_fn bilin_form.to_matrix' (bilin_form.comp_right B f) =
        matrix.mul (coe_fn bilin_form.to_matrix' B) (coe_fn linear_map.to_matrix' f) :=
  sorry

theorem bilin_form.mul_to_matrix'_mul {R₃ : Type u} [comm_ring R₃] {n : Type u_1} {o : Type u_2}
    [fintype n] [fintype o] [DecidableEq n] [DecidableEq o] (B : bilin_form R₃ (n → R₃))
    (M : matrix o n R₃) (N : matrix n o R₃) :
    matrix.mul (matrix.mul M (coe_fn bilin_form.to_matrix' B)) N =
        coe_fn bilin_form.to_matrix'
          (bilin_form.comp B (coe_fn matrix.to_lin' (matrix.transpose M))
            (coe_fn matrix.to_lin' N)) :=
  sorry

theorem bilin_form.mul_to_matrix' {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (M : matrix n n R₃) :
    matrix.mul M (coe_fn bilin_form.to_matrix' B) =
        coe_fn bilin_form.to_matrix'
          (bilin_form.comp_left B (coe_fn matrix.to_lin' (matrix.transpose M))) :=
  sorry

theorem bilin_form.to_matrix'_mul {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] (B : bilin_form R₃ (n → R₃)) (M : matrix n n R₃) :
    matrix.mul (coe_fn bilin_form.to_matrix' B) M =
        coe_fn bilin_form.to_matrix' (bilin_form.comp_right B (coe_fn matrix.to_lin' M)) :=
  sorry

theorem matrix.to_bilin'_comp {R₃ : Type u} [comm_ring R₃] {n : Type u_1} {o : Type u_2} [fintype n]
    [fintype o] [DecidableEq n] [DecidableEq o] (M : matrix n n R₃) (P : matrix n o R₃)
    (Q : matrix n o R₃) :
    bilin_form.comp (coe_fn matrix.to_bilin' M) (coe_fn matrix.to_lin' P)
          (coe_fn matrix.to_lin' Q) =
        coe_fn matrix.to_bilin' (matrix.mul (matrix.mul (matrix.transpose P) M) Q) :=
  sorry

/-! ### `to_matrix` section

This section deals with the conversion between matrices and bilinear forms on
a module with a fixed basis.
-/

/-- `bilin_form.to_matrix hb` is the equivalence between `R`-bilinear forms on `M` and
`n`-by-`n` matrices with entries in `R`, if `hb` is an `R`-basis for `M`. -/
def bilin_form.to_matrix {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) :
    linear_equiv R₃ (bilin_form R₃ M₃) (matrix n n R₃) :=
  linear_equiv.trans (bilin_form.congr (is_basis.equiv_fun hb)) bilin_form.to_matrix'

/-- `bilin_form.to_matrix hb` is the equivalence between `R`-bilinear forms on `M` and
`n`-by-`n` matrices with entries in `R`, if `hb` is an `R`-basis for `M`. -/
def matrix.to_bilin {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃] [module R₃ M₃]
    {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) :
    linear_equiv R₃ (matrix n n R₃) (bilin_form R₃ M₃) :=
  linear_equiv.symm (bilin_form.to_matrix hb)

@[simp] theorem is_basis.equiv_fun_symm_std_basis {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃}
    (hb : is_basis R₃ b) (i : n) :
    coe_fn (linear_equiv.symm (is_basis.equiv_fun hb))
          (coe_fn (linear_map.std_basis R₃ (fun (ᾰ : n) => R₃) i) 1) =
        b i :=
  sorry

@[simp] theorem bilin_form.to_matrix_apply {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃}
    (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) (i : n) (j : n) :
    coe_fn (bilin_form.to_matrix hb) B i j = coe_fn B (b i) (b j) :=
  sorry

@[simp] theorem matrix.to_bilin_apply {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b)
    (M : matrix n n R₃) (x : M₃) (y : M₃) :
    coe_fn (coe_fn (matrix.to_bilin hb) M) x y =
        finset.sum finset.univ
          fun (i : n) =>
            finset.sum finset.univ
              fun (j : n) =>
                coe_fn (coe_fn (is_basis.repr hb) x) i * M i j *
                  coe_fn (coe_fn (is_basis.repr hb) y) j :=
  sorry

-- Not a `simp` lemma since `bilin_form.to_matrix` needs an extra argument

theorem bilinear_form.to_matrix_aux_eq {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃}
    (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) :
    coe_fn (bilin_form.to_matrix_aux b) B = coe_fn (bilin_form.to_matrix hb) B :=
  sorry

@[simp] theorem bilin_form.to_matrix_symm {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃}
    (hb : is_basis R₃ b) : linear_equiv.symm (bilin_form.to_matrix hb) = matrix.to_bilin hb :=
  rfl

@[simp] theorem matrix.to_bilin_symm {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b) :
    linear_equiv.symm (matrix.to_bilin hb) = bilin_form.to_matrix hb :=
  linear_equiv.symm_symm (bilin_form.to_matrix hb)

theorem matrix.to_bilin_is_basis_fun {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] : matrix.to_bilin (pi.is_basis_fun R₃ n) = matrix.to_bilin' :=
  sorry

theorem bilin_form.to_matrix_is_basis_fun {R₃ : Type u} [comm_ring R₃] {n : Type u_1} [fintype n]
    [DecidableEq n] : bilin_form.to_matrix (pi.is_basis_fun R₃ n) = bilin_form.to_matrix' :=
  sorry

@[simp] theorem matrix.to_bilin_to_matrix {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃}
    (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) :
    coe_fn (matrix.to_bilin hb) (coe_fn (bilin_form.to_matrix hb) B) = B :=
  linear_equiv.apply_symm_apply (matrix.to_bilin hb) B

@[simp] theorem bilin_form.to_matrix_to_bilin {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃}
    (hb : is_basis R₃ b) (M : matrix n n R₃) :
    coe_fn (bilin_form.to_matrix hb) (coe_fn (matrix.to_bilin hb) M) = M :=
  linear_equiv.apply_symm_apply (bilin_form.to_matrix hb) M

-- Cannot be a `simp` lemma because `hb` must be inferred.

theorem bilin_form.to_matrix_comp {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {n : Type u_1} {o : Type u_2} [fintype n] [fintype o] [DecidableEq n]
    {b : n → M₃} (hb : is_basis R₃ b) {M₃' : Type u_3} [add_comm_group M₃'] [module R₃ M₃']
    {c : o → M₃'} (hc : is_basis R₃ c) [DecidableEq o] (B : bilin_form R₃ M₃)
    (l : linear_map R₃ M₃' M₃) (r : linear_map R₃ M₃' M₃) :
    coe_fn (bilin_form.to_matrix hc) (bilin_form.comp B l r) =
        matrix.mul
          (matrix.mul (matrix.transpose (coe_fn (linear_map.to_matrix hc hb) l))
            (coe_fn (bilin_form.to_matrix hb) B))
          (coe_fn (linear_map.to_matrix hc hb) r) :=
  sorry

theorem bilin_form.to_matrix_comp_left {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃}
    (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) (f : linear_map R₃ M₃ M₃) :
    coe_fn (bilin_form.to_matrix hb) (bilin_form.comp_left B f) =
        matrix.mul (matrix.transpose (coe_fn (linear_map.to_matrix hb hb) f))
          (coe_fn (bilin_form.to_matrix hb) B) :=
  sorry

theorem bilin_form.to_matrix_comp_right {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃}
    (hb : is_basis R₃ b) (B : bilin_form R₃ M₃) (f : linear_map R₃ M₃ M₃) :
    coe_fn (bilin_form.to_matrix hb) (bilin_form.comp_right B f) =
        matrix.mul (coe_fn (bilin_form.to_matrix hb) B) (coe_fn (linear_map.to_matrix hb hb) f) :=
  sorry

theorem bilin_form.mul_to_matrix_mul {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {n : Type u_1} {o : Type u_2} [fintype n] [fintype o] [DecidableEq n]
    {b : n → M₃} (hb : is_basis R₃ b) {M₃' : Type u_3} [add_comm_group M₃'] [module R₃ M₃']
    {c : o → M₃'} (hc : is_basis R₃ c) [DecidableEq o] (B : bilin_form R₃ M₃) (M : matrix o n R₃)
    (N : matrix n o R₃) :
    matrix.mul (matrix.mul M (coe_fn (bilin_form.to_matrix hb) B)) N =
        coe_fn (bilin_form.to_matrix hc)
          (bilin_form.comp B (coe_fn (matrix.to_lin hc hb) (matrix.transpose M))
            (coe_fn (matrix.to_lin hc hb) N)) :=
  sorry

theorem bilin_form.mul_to_matrix {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b)
    (B : bilin_form R₃ M₃) (M : matrix n n R₃) :
    matrix.mul M (coe_fn (bilin_form.to_matrix hb) B) =
        coe_fn (bilin_form.to_matrix hb)
          (bilin_form.comp_left B (coe_fn (matrix.to_lin hb hb) (matrix.transpose M))) :=
  sorry

theorem bilin_form.to_matrix_mul {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {n : Type u_1} [fintype n] [DecidableEq n] {b : n → M₃} (hb : is_basis R₃ b)
    (B : bilin_form R₃ M₃) (M : matrix n n R₃) :
    matrix.mul (coe_fn (bilin_form.to_matrix hb) B) M =
        coe_fn (bilin_form.to_matrix hb)
          (bilin_form.comp_right B (coe_fn (matrix.to_lin hb hb) M)) :=
  sorry

theorem matrix.to_bilin_comp {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {n : Type u_1} {o : Type u_2} [fintype n] [fintype o] [DecidableEq n]
    {b : n → M₃} (hb : is_basis R₃ b) {M₃' : Type u_3} [add_comm_group M₃'] [module R₃ M₃']
    {c : o → M₃'} (hc : is_basis R₃ c) [DecidableEq o] (M : matrix n n R₃) (P : matrix n o R₃)
    (Q : matrix n o R₃) :
    bilin_form.comp (coe_fn (matrix.to_bilin hb) M) (coe_fn (matrix.to_lin hc hb) P)
          (coe_fn (matrix.to_lin hc hb) Q) =
        coe_fn (matrix.to_bilin hc) (matrix.mul (matrix.mul (matrix.transpose P) M) Q) :=
  sorry

namespace refl_bilin_form

/-- The proposition that a bilinear form is reflexive -/
def is_refl {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    (B : bilin_form R M) :=
  ∀ (x y : M), coe_fn B x y = 0 → coe_fn B y x = 0

theorem eq_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} (H : is_refl B) {x : M} {y : M} : coe_fn B x y = 0 → coe_fn B y x = 0 :=
  H x y

theorem ortho_sym {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} (H : is_refl B) {x : M} {y : M} :
    bilin_form.is_ortho B x y ↔ bilin_form.is_ortho B y x :=
  { mp := eq_zero H, mpr := eq_zero H }

end refl_bilin_form

namespace sym_bilin_form

/-- The proposition that a bilinear form is symmetric -/
def is_sym {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    (B : bilin_form R M) :=
  ∀ (x y : M), coe_fn B x y = coe_fn B y x

theorem sym {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} (H : is_sym B) (x : M) (y : M) : coe_fn B x y = coe_fn B y x :=
  H x y

theorem is_refl {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} (H : is_sym B) : refl_bilin_form.is_refl B :=
  fun (x y : M) (H1 : coe_fn B x y = 0) => H x y ▸ H1

theorem ortho_sym {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} (H : is_sym B) {x : M} {y : M} :
    bilin_form.is_ortho B x y ↔ bilin_form.is_ortho B y x :=
  refl_bilin_form.ortho_sym (is_refl H)

end sym_bilin_form

namespace alt_bilin_form

/-- The proposition that a bilinear form is alternating -/
def is_alt {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    (B : bilin_form R M) :=
  ∀ (x : M), coe_fn B x x = 0

theorem self_eq_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    {B : bilin_form R M} (H : is_alt B) (x : M) : coe_fn B x x = 0 :=
  H x

theorem neg {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁]
    {B₁ : bilin_form R₁ M₁} (H : is_alt B₁) (x : M₁) (y : M₁) : -coe_fn B₁ x y = coe_fn B₁ y x :=
  sorry

end alt_bilin_form

namespace bilin_form

/-- Given a pair of modules equipped with bilinear forms, this is the condition for a pair of
maps between them to be mutually adjoint. -/
def is_adjoint_pair {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    (B : bilin_form R M) {M' : Type u_1} [add_comm_monoid M'] [semimodule R M']
    (B' : bilin_form R M') (f : linear_map R M M') (g : linear_map R M' M) :=
  ∀ {x : M} {y : M'}, coe_fn B' (coe_fn f x) y = coe_fn B x (coe_fn g y)

theorem is_adjoint_pair.eq {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} {M' : Type u_1} [add_comm_monoid M'] [semimodule R M']
    {B' : bilin_form R M'} {f : linear_map R M M'} {g : linear_map R M' M}
    (h : is_adjoint_pair B B' f g) {x : M} {y : M'} :
    coe_fn B' (coe_fn f x) y = coe_fn B x (coe_fn g y) :=
  h

theorem is_adjoint_pair_iff_comp_left_eq_comp_right {R : Type u} {M : Type v} [semiring R]
    [add_comm_monoid M] [semimodule R M] {B : bilin_form R M} (F : bilin_form R M)
    (f : module.End R M) (g : module.End R M) :
    is_adjoint_pair B F f g ↔ comp_left F f = comp_right B g :=
  sorry

theorem is_adjoint_pair_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} {M' : Type u_1} [add_comm_monoid M'] [semimodule R M']
    {B' : bilin_form R M'} : is_adjoint_pair B B' 0 0 :=
  sorry

theorem is_adjoint_pair_id {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} : is_adjoint_pair B B 1 1 :=
  fun (x y : M) => rfl

theorem is_adjoint_pair.add {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} {M' : Type u_1} [add_comm_monoid M'] [semimodule R M']
    {B' : bilin_form R M'} {f : linear_map R M M'} {f' : linear_map R M M'} {g : linear_map R M' M}
    {g' : linear_map R M' M} (h : is_adjoint_pair B B' f g) (h' : is_adjoint_pair B B' f' g') :
    is_adjoint_pair B B' (f + f') (g + g') :=
  sorry

theorem is_adjoint_pair.sub {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁]
    {B₁ : bilin_form R₁ M₁} {M₁' : Type u_2} [add_comm_group M₁'] [module R₁ M₁']
    {B₁' : bilin_form R₁ M₁'} {f₁ : linear_map R₁ M₁ M₁'} {f₁' : linear_map R₁ M₁ M₁'}
    {g₁ : linear_map R₁ M₁' M₁} {g₁' : linear_map R₁ M₁' M₁} (h : is_adjoint_pair B₁ B₁' f₁ g₁)
    (h' : is_adjoint_pair B₁ B₁' f₁' g₁') : is_adjoint_pair B₁ B₁' (f₁ - f₁') (g₁ - g₁') :=
  sorry

theorem is_adjoint_pair.smul {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] {B₂ : bilin_form R₂ M₂} {M₂' : Type u_3} [add_comm_monoid M₂']
    [semimodule R₂ M₂'] {B₂' : bilin_form R₂ M₂'} {f₂ : linear_map R₂ M₂ M₂'}
    {g₂ : linear_map R₂ M₂' M₂} (c : R₂) (h : is_adjoint_pair B₂ B₂' f₂ g₂) :
    is_adjoint_pair B₂ B₂' (c • f₂) (c • g₂) :=
  sorry

theorem is_adjoint_pair.comp {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} {M' : Type u_1} [add_comm_monoid M'] [semimodule R M']
    {B' : bilin_form R M'} {f : linear_map R M M'} {g : linear_map R M' M} {M'' : Type u_4}
    [add_comm_monoid M''] [semimodule R M''] (B'' : bilin_form R M'') {f' : linear_map R M' M''}
    {g' : linear_map R M'' M'} (h : is_adjoint_pair B B' f g) (h' : is_adjoint_pair B' B'' f' g') :
    is_adjoint_pair B B'' (linear_map.comp f' f) (linear_map.comp g g') :=
  sorry

theorem is_adjoint_pair.mul {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M]
    [semimodule R M] {B : bilin_form R M} {f : module.End R M} {g : module.End R M}
    {f' : module.End R M} {g' : module.End R M} (h : is_adjoint_pair B B f g)
    (h' : is_adjoint_pair B B f' g') : is_adjoint_pair B B (f * f') (g' * g) :=
  sorry

/-- The condition for an endomorphism to be "self-adjoint" with respect to a pair of bilinear forms
on the underlying module. In the case that these two forms are identical, this is the usual concept
of self adjointness. In the case that one of the forms is the negation of the other, this is the
usual concept of skew adjointness. -/
def is_pair_self_adjoint {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    (B : bilin_form R M) (F : bilin_form R M) (f : module.End R M) :=
  is_adjoint_pair B F f f

/-- The set of pair-self-adjoint endomorphisms are a submodule of the type of all endomorphisms. -/
def is_pair_self_adjoint_submodule {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] (B₂ : bilin_form R₂ M₂) (F₂ : bilin_form R₂ M₂) :
    submodule R₂ (module.End R₂ M₂) :=
  submodule.mk (set_of fun (f : module.End R₂ M₂) => is_pair_self_adjoint B₂ F₂ f) sorry sorry sorry

@[simp] theorem mem_is_pair_self_adjoint_submodule {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] (B₂ : bilin_form R₂ M₂) (F₂ : bilin_form R₂ M₂)
    (f : module.End R₂ M₂) :
    f ∈ is_pair_self_adjoint_submodule B₂ F₂ ↔ is_pair_self_adjoint B₂ F₂ f :=
  iff.refl (f ∈ is_pair_self_adjoint_submodule B₂ F₂)

theorem is_pair_self_adjoint_equiv {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] {M₃' : Type u_5} [add_comm_group M₃'] [module R₃ M₃'] (B₃ : bilin_form R₃ M₃)
    (F₃ : bilin_form R₃ M₃) (e : linear_equiv R₃ M₃' M₃) (f : module.End R₃ M₃) :
    is_pair_self_adjoint B₃ F₃ f ↔
        is_pair_self_adjoint (comp B₃ ↑e ↑e) (comp F₃ ↑e ↑e)
          (coe_fn (linear_equiv.conj (linear_equiv.symm e)) f) :=
  sorry

/-- An endomorphism of a module is self-adjoint with respect to a bilinear form if it serves as an
adjoint for itself. -/
def is_self_adjoint {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M]
    (B : bilin_form R M) (f : module.End R M) :=
  is_adjoint_pair B B f f

/-- An endomorphism of a module is skew-adjoint with respect to a bilinear form if its negation
serves as an adjoint. -/
def is_skew_adjoint {R₁ : Type u} {M₁ : Type v} [ring R₁] [add_comm_group M₁] [module R₁ M₁]
    (B₁ : bilin_form R₁ M₁) (f : module.End R₁ M₁) :=
  is_adjoint_pair B₁ B₁ f (-f)

theorem is_skew_adjoint_iff_neg_self_adjoint {R₁ : Type u} {M₁ : Type v} [ring R₁]
    [add_comm_group M₁] [module R₁ M₁] (B₁ : bilin_form R₁ M₁) (f : module.End R₁ M₁) :
    is_skew_adjoint B₁ f ↔ is_adjoint_pair (-B₁) B₁ f f :=
  sorry

/-- The set of self-adjoint endomorphisms of a module with bilinear form is a submodule. (In fact
it is a Jordan subalgebra.) -/
def self_adjoint_submodule {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂] [add_comm_monoid M₂]
    [semimodule R₂ M₂] (B₂ : bilin_form R₂ M₂) : submodule R₂ (module.End R₂ M₂) :=
  is_pair_self_adjoint_submodule B₂ B₂

@[simp] theorem mem_self_adjoint_submodule {R₂ : Type u} {M₂ : Type v} [comm_semiring R₂]
    [add_comm_monoid M₂] [semimodule R₂ M₂] (B₂ : bilin_form R₂ M₂) (f : module.End R₂ M₂) :
    f ∈ self_adjoint_submodule B₂ ↔ is_self_adjoint B₂ f :=
  iff.rfl

/-- The set of skew-adjoint endomorphisms of a module with bilinear form is a submodule. (In fact
it is a Lie subalgebra.) -/
def skew_adjoint_submodule {R₃ : Type u} {M₃ : Type v} [comm_ring R₃] [add_comm_group M₃]
    [module R₃ M₃] (B₃ : bilin_form R₃ M₃) : submodule R₃ (module.End R₃ M₃) :=
  is_pair_self_adjoint_submodule (-B₃) B₃

@[simp] theorem mem_skew_adjoint_submodule {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] (B₃ : bilin_form R₃ M₃) (f : module.End R₃ M₃) :
    f ∈ skew_adjoint_submodule B₃ ↔ is_skew_adjoint B₃ f :=
  sorry

end bilin_form

/-- The condition for the square matrices `A`, `A'` to be an adjoint pair with respect to the square
matrices `J`, `J₃`. -/
def matrix.is_adjoint_pair {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃)
    (J₃ : matrix n n R₃) (A : matrix n n R₃) (A' : matrix n n R₃) :=
  matrix.mul (matrix.transpose A) J₃ = matrix.mul J A'

/-- The condition for a square matrix `A` to be self-adjoint with respect to the square matrix
`J`. -/
def matrix.is_self_adjoint {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃)
    (A : matrix n n R₃) :=
  matrix.is_adjoint_pair J J A A

/-- The condition for a square matrix `A` to be skew-adjoint with respect to the square matrix
`J`. -/
def matrix.is_skew_adjoint {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n] (J : matrix n n R₃)
    (A : matrix n n R₃) :=
  matrix.is_adjoint_pair J J A (-A)

@[simp] theorem is_adjoint_pair_to_bilin' {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n]
    (J : matrix n n R₃) (J₃ : matrix n n R₃) (A : matrix n n R₃) (A' : matrix n n R₃)
    [DecidableEq n] :
    bilin_form.is_adjoint_pair (coe_fn matrix.to_bilin' J) (coe_fn matrix.to_bilin' J₃)
          (coe_fn matrix.to_lin' A) (coe_fn matrix.to_lin' A') ↔
        matrix.is_adjoint_pair J J₃ A A' :=
  sorry

@[simp] theorem is_adjoint_pair_to_bilin {R₃ : Type u} {M₃ : Type v} [comm_ring R₃]
    [add_comm_group M₃] [module R₃ M₃] {n : Type w} [fintype n] {b : n → M₃} (hb : is_basis R₃ b)
    (J : matrix n n R₃) (J₃ : matrix n n R₃) (A : matrix n n R₃) (A' : matrix n n R₃)
    [DecidableEq n] :
    bilin_form.is_adjoint_pair (coe_fn (matrix.to_bilin hb) J) (coe_fn (matrix.to_bilin hb) J₃)
          (coe_fn (matrix.to_lin hb hb) A) (coe_fn (matrix.to_lin hb hb) A') ↔
        matrix.is_adjoint_pair J J₃ A A' :=
  sorry

theorem matrix.is_adjoint_pair_equiv {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n]
    (J : matrix n n R₃) (A : matrix n n R₃) (A' : matrix n n R₃) [DecidableEq n] (P : matrix n n R₃)
    (h : is_unit P) :
    matrix.is_adjoint_pair (matrix.mul (matrix.mul (matrix.transpose P) J) P)
          (matrix.mul (matrix.mul (matrix.transpose P) J) P) A A' ↔
        matrix.is_adjoint_pair J J (matrix.mul (matrix.mul P A) (P⁻¹))
          (matrix.mul (matrix.mul P A') (P⁻¹)) :=
  sorry

/-- The submodule of pair-self-adjoint matrices with respect to bilinear forms corresponding to
given matrices `J`, `J₂`. -/
def pair_self_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n]
    (J : matrix n n R₃) (J₃ : matrix n n R₃) [DecidableEq n] : submodule R₃ (matrix n n R₃) :=
  submodule.map (↑linear_map.to_matrix')
    (bilin_form.is_pair_self_adjoint_submodule (coe_fn matrix.to_bilin' J)
      (coe_fn matrix.to_bilin' J₃))

@[simp] theorem mem_pair_self_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w}
    [fintype n] (J : matrix n n R₃) (J₃ : matrix n n R₃) (A : matrix n n R₃) [DecidableEq n] :
    A ∈ pair_self_adjoint_matrices_submodule J J₃ ↔ matrix.is_adjoint_pair J J₃ A A :=
  sorry

/-- The submodule of self-adjoint matrices with respect to the bilinear form corresponding to
the matrix `J`. -/
def self_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n]
    (J : matrix n n R₃) [DecidableEq n] : submodule R₃ (matrix n n R₃) :=
  pair_self_adjoint_matrices_submodule J J

@[simp] theorem mem_self_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w}
    [fintype n] (J : matrix n n R₃) (A : matrix n n R₃) [DecidableEq n] :
    A ∈ self_adjoint_matrices_submodule J ↔ matrix.is_self_adjoint J A :=
  sorry

/-- The submodule of skew-adjoint matrices with respect to the bilinear form corresponding to
the matrix `J`. -/
def skew_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w} [fintype n]
    (J : matrix n n R₃) [DecidableEq n] : submodule R₃ (matrix n n R₃) :=
  pair_self_adjoint_matrices_submodule (-J) J

@[simp] theorem mem_skew_adjoint_matrices_submodule {R₃ : Type u} [comm_ring R₃] {n : Type w}
    [fintype n] (J : matrix n n R₃) (A : matrix n n R₃) [DecidableEq n] :
    A ∈ skew_adjoint_matrices_submodule J ↔ matrix.is_skew_adjoint J A :=
  sorry

end Mathlib


import typ.open

namespace tts ------------------------------------------------------------------
namespace typ ------------------------------------------------------------------
variables {V : Type} [_root_.decidable_eq V] -- Type of variable names
variables {t t₁ t₂ : typ V} -- Types
variables {ts : list (typ V)} -- Lists of types

open occurs

/-- Locally-closed type -/
inductive lc : typ V → Prop
| var : Π (x : tagged V),                  lc (var free x)
| arr : Π {t₁ t₂ : typ V}, lc t₁ → lc t₂ → lc (arr t₁ t₂)

/-- Locally-closed body of a type scheme with a given arity -/
def lc_body (n : ℕ) (t : typ V) : Prop :=
∃ (L : finset (tagged V)),
∀ {xs : list (tagged V)},
xs.nodup →
xs.length = n →
(∀ {x : tagged V}, x ∈ xs → x ∉ L) →
lc (open_vars xs t)

@[simp] theorem lc_var_free (x : tagged V) : lc (var free x) :=
lc.var x

@[simp] theorem lc_arr : lc (arr t₁ t₂) ↔ lc t₁ ∧ lc t₂ :=
⟨λ l, by cases l with _ _ _ l₁ l₂; exact ⟨l₁, l₂⟩, λ ⟨l₁, l₂⟩, lc.arr l₁ l₂⟩

-- Opening a locally-closed type is the identity
@[simp] theorem open_typs_id (l : lc t) : open_typs ts t = t :=
by induction t; cases l; simp [open_typs, *]

end /- namespace -/ typ --------------------------------------------------------
end /- namespace -/ tts --------------------------------------------------------


/-
Copyright (c) 2017 Gabriel Ebner. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner
-/
import .clause .prover_state .utils
open tactic monad expr native

namespace super

def position := list ℕ

meta def get_rwr_positions : expr → list position
| (app a b) := [[]] ++
  do arg ← list.zip_with_index (get_app_args (app a b)),
     pos ← get_rwr_positions arg.1,
     [arg.2 :: pos]
| (var _) := []
| e := [[]]

meta def get_position : expr → position → expr
| (app a b) (p::ps) :=
match list.nth (get_app_args (app a b)) p with
| some arg := get_position arg ps
| none := (app a b)
end
| e _ := e

meta def replace_position (v : expr) : expr → position → expr
| (app a b) (p::ps) :=
let args := get_app_args (app a b) in
match args.nth p with
| some arg := app_of_list a.get_app_fn $ args.update_nth p $ replace_position arg ps
| none := app a b
end
| e [] := v
| e _ := e

variable gt : expr → expr → bool
variables (c1 c2 : clause)
variables (ac1 ac2 : derived_clause)
variables (i1 i2 : nat)
variable pos : list ℕ
variable ltr : bool
variable lt_in_termorder : bool
variable congr_ax : name

lemma {u v w} sup_ltr (F : Sort u) (A : Sort v) (a1 a2) (f : A → Sort w) : (f a1 → F) → f a2 → a1 = a2 → F :=
assume  hnfa1 hfa2 he, hnfa1 (@eq.rec A a2 f hfa2 a1 he.symm)
lemma {u v w} sup_rtl (F : Sort u) (A : Sort v) (a1 a2) (f : A → Sort w) : (f a1 → F) → f a2 → a2 = a1 → F :=
assume  hnfa1 hfa2 heq, hnfa1 (@eq.rec A a2 f hfa2 a1 heq)

meta def is_eq_dir (e : expr) (ltr : bool) : option (expr × expr) :=
match is_eq e with
| some (lhs, rhs) := if ltr then some (lhs, rhs) else some (rhs, lhs)
| none := none
end

meta def try_sup : tactic clause := do
guard $ (c1.get_lit i1).is_pos,
qf1 ← c1.open_metan c1.num_quants,
qf2 ← c2.open_metan c2.num_quants,
(rwr_from, rwr_to) ← (is_eq_dir (qf1.1.get_lit i1).formula ltr).to_monad,
atom ← return (qf2.1.get_lit i2).formula,
eq_type ← infer_type rwr_from,
atom_at_pos ← return $ get_position atom pos,
atom_at_pos_type ← infer_type atom_at_pos,
unify eq_type atom_at_pos_type,
unify rwr_from atom_at_pos transparency.none,
rwr_from' ← instantiate_mvars atom_at_pos,
rwr_to' ← instantiate_mvars rwr_to,
if lt_in_termorder
  then guard (gt rwr_from' rwr_to')
  else guard (¬gt rwr_to' rwr_from'),
rwr_ctx_varn ← mk_fresh_name,
abs_rwr_ctx ← return $
  lam rwr_ctx_varn binder_info.default eq_type
  (if (qf2.1.get_lit i2).is_neg
   then replace_position (mk_var 0) atom pos
   else imp (replace_position (mk_var 0) atom pos) c2.local_false),
lf_univ ← infer_univ c1.local_false,
univ ← infer_univ eq_type,
atom_univ ← infer_univ atom,
op1 ← qf1.1.open_constn i1,
op2 ← qf2.1.open_constn c2.num_lits,
hi2 ← (op2.2.nth i2).to_monad,
new_atom ← whnf_no_delta $ app abs_rwr_ctx rwr_to',
new_hi2 ← return $ local_const hi2.local_uniq_name `H binder_info.default new_atom,
new_fin_prf ←
  return $ app_of_list (const congr_ax [lf_univ, univ, atom_univ]) [c1.local_false, eq_type, rwr_from, rwr_to,
            abs_rwr_ctx, (op2.1.close_const hi2).proof, new_hi2],
clause.meta_closure (qf1.2 ++ qf2.2) $ (op1.1.inst new_fin_prf).close_constn (op1.2 ++ op2.2.update_nth i2 new_hi2)

meta def rwr_positions (c : clause) (i : nat) : list (list ℕ) :=
get_rwr_positions (c.get_lit i).formula

meta def try_add_sup : prover unit :=
(do c' ← try_sup gt ac1.c ac2.c i1 i2 pos ltr ff congr_ax,
    inf_score 2 [ac1.sc, ac2.sc] >>= mk_derived c' >>= add_inferred)
  <|> return ()

meta def superposition_back_inf : inference :=
assume  given, do active ← get_active, sequence' $ do
  given_i ← given.selected,
  guard (given.c.get_lit given_i).is_pos,
  option.to_monad $ is_eq (given.c.get_lit given_i).formula,
  other ← rb_map.values active,
  guard $ ¬given.sc.in_sos ∨ ¬other.sc.in_sos,
  other_i ← other.selected,
  pos ← rwr_positions other.c other_i,
  -- FIXME(gabriel): ``sup_ltr fails to resolve at runtime
  [do try_add_sup gt given other given_i other_i pos tt ``super.sup_ltr,
      try_add_sup gt given other given_i other_i pos ff ``super.sup_rtl]

meta def superposition_fwd_inf : inference :=
assume  given, do active ← get_active, sequence' $ do
  given_i ← given.selected,
  other ← rb_map.values active,
  guard $ ¬given.sc.in_sos ∨ ¬other.sc.in_sos,
  other_i ← other.selected,
  guard (other.c.get_lit other_i).is_pos,
  option.to_monad $ is_eq (other.c.get_lit other_i).formula,
  pos ← rwr_positions given.c given_i,
  [do try_add_sup gt other given other_i given_i pos tt ``super.sup_ltr,
      try_add_sup gt other given other_i given_i pos ff ``super.sup_rtl]

@[super.inf]
meta def superposition_inf : inf_decl := inf_decl.mk 40 $
assume  given, do gt ← get_term_order,
superposition_fwd_inf gt given,
superposition_back_inf gt given

end super


/-
Copyright (c) 2018 Sean Leather. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sean Leather, Mario Carneiro
-/
import data.list.sigma

/-!
# Association lists
-/

universes u v w
open list
variables {α : Type u} {β : α → Type v}

/-- `alist β` is a key-value map stored as a `list` (i.e. a linked list).
  It is a wrapper around certain `list` functions with the added constraint
  that the list have unique keys. -/
structure alist (β : α → Type v) : Type (max u v) :=
(entries : list (sigma β))
(nodupkeys : entries.nodupkeys)

/-- Given `l : list (sigma β)`, create a term of type `alist β` by removing
entries with duplicate keys. -/
def list.to_alist [decidable_eq α] {β : α → Type v} (l : list (sigma β)) : alist β :=
{ entries := _,
  nodupkeys := nodupkeys_erase_dupkeys l }

namespace alist

@[ext] theorem ext : ∀ {s t : alist β}, s.entries = t.entries → s = t
| ⟨l₁, h₁⟩ ⟨l₂, h₂⟩ H := by congr'

lemma ext_iff {s t : alist β} : s = t ↔ s.entries = t.entries :=
⟨congr_arg _, ext⟩

instance [decidable_eq α] [∀ a, decidable_eq (β a)] : decidable_eq (alist β) :=
λ xs ys, by rw ext_iff; apply_instance

/-! ### keys -/

/-- The list of keys of an association list. -/
def keys (s : alist β) : list α := s.entries.keys

theorem keys_nodup (s : alist β) : s.keys.nodup := s.nodupkeys

/-! ### mem -/

/-- The predicate `a ∈ s` means that `s` has a value associated to the key `a`. -/
instance : has_mem α (alist β) := ⟨λ a s, a ∈ s.keys⟩

theorem mem_keys {a : α} {s : alist β} : a ∈ s ↔ a ∈ s.keys := iff.rfl

theorem mem_of_perm {a : α} {s₁ s₂ : alist β} (p : s₁.entries ~ s₂.entries) : a ∈ s₁ ↔ a ∈ s₂ :=
(p.map sigma.fst).mem_iff

/-! ### empty -/

/-- The empty association list. -/
instance : has_emptyc (alist β) := ⟨⟨[], nodupkeys_nil⟩⟩

instance : inhabited (alist β) := ⟨∅⟩

theorem not_mem_empty (a : α) : a ∉ (∅ : alist β) :=
not_mem_nil a

@[simp] theorem empty_entries : (∅ : alist β).entries = [] := rfl

@[simp] theorem keys_empty : (∅ : alist β).keys = [] := rfl

/-! ### singleton -/

/-- The singleton association list. -/
def singleton (a : α) (b : β a) : alist β :=
⟨[⟨a, b⟩], nodupkeys_singleton _⟩

@[simp]

@[simp] theorem keys_singleton (a : α) (b : β a) : (singleton a b).keys = [a] := rfl

/-! ### lookup -/

section

variables [decidable_eq α]

/-- Look up the value associated to a key in an association list. -/
def lookup (a : α) (s : alist β) : option (β a) :=
s.entries.lookup a

@[simp] theorem lookup_empty (a) : lookup a (∅ : alist β) = none :=
rfl

theorem lookup_is_some {a : α} {s : alist β} :
  (s.lookup a).is_some ↔ a ∈ s := lookup_is_some

theorem lookup_eq_none {a : α} {s : alist β} :
  lookup a s = none ↔ a ∉ s :=
lookup_eq_none

theorem perm_lookup {a : α} {s₁ s₂ : alist β} (p : s₁.entries ~ s₂.entries) :
  s₁.lookup a = s₂.lookup a :=
perm_lookup _ s₁.nodupkeys s₂.nodupkeys p

instance (a : α) (s : alist β) : decidable (a ∈ s) :=
decidable_of_iff _ lookup_is_some

/-! ### replace -/

/-- Replace a key with a given value in an association list.
  If the key is not present it does nothing. -/
def replace (a : α) (b : β a) (s : alist β) : alist β :=
⟨kreplace a b s.entries, (kreplace_nodupkeys a b).2 s.nodupkeys⟩

@[simp] theorem keys_replace (a : α) (b : β a) (s : alist β) :
  (replace a b s).keys = s.keys :=
keys_kreplace _ _ _

@[simp] theorem mem_replace {a a' : α} {b : β a} {s : alist β} :
  a' ∈ replace a b s ↔ a' ∈ s :=
by rw [mem_keys, keys_replace, ←mem_keys]

theorem perm_replace {a : α} {b : β a} {s₁ s₂ : alist β} :
  s₁.entries ~ s₂.entries → (replace a b s₁).entries ~ (replace a b s₂).entries :=
perm.kreplace s₁.nodupkeys

end

/-- Fold a function over the key-value pairs in the map. -/
def foldl {δ : Type w} (f : δ → Π a, β a → δ) (d : δ) (m : alist β) : δ :=
m.entries.foldl (λ r a, f r a.1 a.2) d

/-! ### erase -/

section

variables [decidable_eq α]

/-- Erase a key from the map. If the key is not present, do nothing. -/
def erase (a : α) (s : alist β) : alist β :=
⟨kerase a s.entries, kerase_nodupkeys _ s.nodupkeys⟩

@[simp] theorem keys_erase (a : α) (s : alist β) :
  (erase a s).keys = s.keys.erase a :=
by simp only [erase, keys, keys_kerase]

@[simp] theorem mem_erase {a a' : α} {s : alist β} : a' ∈ erase a s ↔ a' ≠ a ∧ a' ∈ s :=
by rw [mem_keys, keys_erase, mem_erase_iff_of_nodup s.keys_nodup, ←mem_keys]

theorem perm_erase {a : α} {s₁ s₂ : alist β} :
  s₁.entries ~ s₂.entries → (erase a s₁).entries ~ (erase a s₂).entries :=
perm.kerase s₁.nodupkeys

@[simp] theorem lookup_erase (a) (s : alist β) : lookup a (erase a s) = none :=
lookup_kerase a s.nodupkeys

@[simp] theorem lookup_erase_ne {a a'} {s : alist β} (h : a ≠ a') :
  lookup a (erase a' s) = lookup a s :=
lookup_kerase_ne h

theorem erase_erase (a a' : α) (s : alist β) :
  (s.erase a).erase a' = (s.erase a').erase a :=
ext $ kerase_kerase

/-! ### insert -/

/-- Insert a key-value pair into an association list and erase any existing pair
  with the same key. -/
def insert (a : α) (b : β a) (s : alist β) : alist β :=
⟨kinsert a b s.entries, kinsert_nodupkeys a b s.nodupkeys⟩

@[simp] theorem insert_entries {a} {b : β a} {s : alist β} :
  (insert a b s).entries = sigma.mk a b :: kerase a s.entries :=
rfl

theorem insert_entries_of_neg {a} {b : β a} {s : alist β} (h : a ∉ s) :
  (insert a b s).entries = ⟨a, b⟩ :: s.entries :=
by rw [insert_entries, kerase_of_not_mem_keys h]

@[simp] theorem mem_insert {a a'} {b' : β a'} (s : alist β) :
  a ∈ insert a' b' s ↔ a = a' ∨ a ∈ s :=
mem_keys_kinsert

@[simp] theorem keys_insert {a} {b : β a} (s : alist β) :
  (insert a b s).keys = a :: s.keys.erase a :=
by simp [insert, keys, keys_kerase]

theorem perm_insert {a} {b : β a} {s₁ s₂ : alist β} (p : s₁.entries ~ s₂.entries) :
  (insert a b s₁).entries ~ (insert a b s₂).entries :=
by simp only [insert_entries]; exact p.kinsert s₁.nodupkeys

@[simp] theorem lookup_insert {a} {b : β a} (s : alist β) : lookup a (insert a b s) = some b :=
by simp only [lookup, insert, lookup_kinsert]

@[simp] theorem lookup_insert_ne {a a'} {b' : β a'} {s : alist β} (h : a ≠ a') :
  lookup a (insert a' b' s) = lookup a s :=
lookup_kinsert_ne h

@[simp] theorem lookup_to_alist {a} (s : list (sigma β)) : lookup a s.to_alist = s.lookup a :=
by rw [list.to_alist,lookup,lookup_erase_dupkeys]

@[simp] theorem insert_insert {a} {b b' : β a} (s : alist β) :
  (s.insert a b).insert a b' = s.insert a b' :=
by ext : 1; simp only [alist.insert_entries, list.kerase_cons_eq];
   constructor_matching* [_ ∧ _]; refl

theorem insert_insert_of_ne {a a'} {b : β a} {b' : β a'} (s : alist β) (h : a ≠ a') :
  ((s.insert a b).insert a' b').entries ~ ((s.insert a' b').insert a b).entries :=
by simp only [insert_entries]; rw [kerase_cons_ne,kerase_cons_ne,kerase_comm];
   [apply perm.swap, exact h, exact h.symm]

@[simp] lemma insert_singleton_eq {a : α} {b b' : β a} :
  insert a b (singleton a b') = singleton a b :=
ext $ by simp only [alist.insert_entries, list.kerase_cons_eq, and_self, alist.singleton_entries,
  heq_iff_eq, eq_self_iff_true]

@[simp] theorem entries_to_alist (xs : list (sigma β)) :
  (list.to_alist xs).entries = erase_dupkeys xs := rfl

theorem to_alist_cons (a : α) (b : β a) (xs : list (sigma β)) :
  list.to_alist (⟨a,b⟩ :: xs) = insert a b xs.to_alist := rfl

/-! ### extract -/

/-- Erase a key from the map, and return the corresponding value, if found. -/
def extract (a : α) (s : alist β) : option (β a) × alist β :=
have (kextract a s.entries).2.nodupkeys,
by rw [kextract_eq_lookup_kerase]; exact kerase_nodupkeys _ s.nodupkeys,
match kextract a s.entries, this with
| (b, l), h := (b, ⟨l, h⟩)
end

@[simp] theorem extract_eq_lookup_erase (a : α) (s : alist β) :
  extract a s = (lookup a s, erase a s) :=
by simp [extract]; split; refl

/-! ### union -/

/-- `s₁ ∪ s₂` is the key-based union of two association lists. It is
left-biased: if there exists an `a ∈ s₁`, `lookup a (s₁ ∪ s₂) = lookup a s₁`.
-/
def union (s₁ s₂ : alist β) : alist β :=
⟨kunion s₁.entries s₂.entries, kunion_nodupkeys s₁.nodupkeys s₂.nodupkeys⟩

instance : has_union (alist β) := ⟨union⟩

@[simp] theorem union_entries {s₁ s₂ : alist β} :
  (s₁ ∪ s₂).entries = kunion s₁.entries s₂.entries :=
rfl

@[simp] theorem empty_union {s : alist β} : (∅ : alist β) ∪ s = s :=
ext rfl

@[simp] theorem union_empty {s : alist β} : s ∪ (∅ : alist β) = s :=
ext $ by simp

@[simp] theorem mem_union {a} {s₁ s₂ : alist β} :
  a ∈ s₁ ∪ s₂ ↔ a ∈ s₁ ∨ a ∈ s₂ :=
mem_keys_kunion

theorem perm_union {s₁ s₂ s₃ s₄ : alist β}
  (p₁₂ : s₁.entries ~ s₂.entries) (p₃₄ : s₃.entries ~ s₄.entries) :
  (s₁ ∪ s₃).entries ~ (s₂ ∪ s₄).entries :=
by simp [p₁₂.kunion s₃.nodupkeys p₃₄]

theorem union_erase (a : α) (s₁ s₂ : alist β) : erase a (s₁ ∪ s₂) = erase a s₁ ∪ erase a s₂ :=
ext kunion_kerase.symm

@[simp] theorem lookup_union_left {a} {s₁ s₂ : alist β} :
  a ∈ s₁ → lookup a (s₁ ∪ s₂) = lookup a s₁ :=
lookup_kunion_left

@[simp] theorem lookup_union_right {a} {s₁ s₂ : alist β} :
  a ∉ s₁ → lookup a (s₁ ∪ s₂) = lookup a s₂ :=
lookup_kunion_right

@[simp] theorem mem_lookup_union {a} {b : β a} {s₁ s₂ : alist β} :
  b ∈ lookup a (s₁ ∪ s₂) ↔ b ∈ lookup a s₁ ∨ a ∉ s₁ ∧ b ∈ lookup a s₂ :=
mem_lookup_kunion

theorem mem_lookup_union_middle {a} {b : β a} {s₁ s₂ s₃ : alist β} :
  b ∈ lookup a (s₁ ∪ s₃) → a ∉ s₂ → b ∈ lookup a (s₁ ∪ s₂ ∪ s₃) :=
mem_lookup_kunion_middle

theorem insert_union {a} {b : β a} {s₁ s₂ : alist β} :
  insert a b (s₁ ∪ s₂) = insert a b s₁ ∪ s₂ :=
by ext; simp

theorem union_assoc {s₁ s₂ s₃ : alist β} : ((s₁ ∪ s₂) ∪ s₃).entries ~ (s₁ ∪ (s₂ ∪ s₃)).entries :=
lookup_ext (alist.nodupkeys _) (alist.nodupkeys _)
(by simp [decidable.not_or_iff_and_not,or_assoc,and_or_distrib_left,and_assoc])

end

/-! ### disjoint -/

/-- Two associative lists are disjoint if they have no common keys. -/
def disjoint (s₁ s₂ : alist β) : Prop :=
∀ k ∈ s₁.keys, ¬ k ∈ s₂.keys

variables [decidable_eq α]

theorem union_comm_of_disjoint {s₁ s₂ : alist β} (h : disjoint s₁ s₂) :
  (s₁ ∪ s₂).entries ~ (s₂ ∪ s₁).entries :=
lookup_ext (alist.nodupkeys _) (alist.nodupkeys _)
(begin
   intros, simp,
   split; intro h',
   cases h',
   { right, refine ⟨_,h'⟩,
     apply h, rw [keys,← list.lookup_is_some,h'], exact rfl },
   { left, rw h'.2 },
   cases h',
   { right, refine ⟨_,h'⟩, intro h'',
     apply h _ h'', rw [keys,← list.lookup_is_some,h'], exact rfl },
   { left, rw h'.2 },
 end)

end alist


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.sheaves.presheaf
import Mathlib.category_theory.limits.punit
import Mathlib.category_theory.limits.shapes.products
import Mathlib.category_theory.limits.shapes.equalizers
import Mathlib.category_theory.full_subcategory
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# The sheaf condition in terms of an equalizer of products

Here we set up the machinery for the "usual" definition of the sheaf condition,
e.g. as in https://stacks.math.columbia.edu/tag/0072
in terms of an equalizer diagram where the two objects are
`∏ F.obj (U i)` and `∏ F.obj (U i) ⊓ (U j)`.

-/

namespace Top

namespace presheaf

namespace sheaf_condition_equalizer_products

/-- The product of the sections of a presheaf over a family of open sets. -/
/--
def pi_opens {C : Type u} [category_theory.category C] [category_theory.limits.has_products C]
    {X : Top} (F : presheaf C X) {ι : Type v} (U : ι → topological_space.opens ↥X) : C :=
  ∏ fun (i : ι) => category_theory.functor.obj F (opposite.op (U i))

The product of the sections of a presheaf over the pairwise intersections of
a family of open sets.
-/
def pi_inters {C : Type u} [category_theory.category C] [category_theory.limits.has_products C]
    {X : Top} (F : presheaf C X) {ι : Type v} (U : ι → topological_space.opens ↥X) : C :=
  ∏ fun (p : ι × ι) => category_theory.functor.obj F (opposite.op (U (prod.fst p) ⊓ U (prod.snd p)))

/--
The morphism `Π F.obj (U i) ⟶ Π F.obj (U i) ⊓ (U j)` whose components
are given by the restriction maps from `U i` to `U i ⊓ U j`.
-/
def left_res {C : Type u} [category_theory.category C] [category_theory.limits.has_products C]
    {X : Top} (F : presheaf C X) {ι : Type v} (U : ι → topological_space.opens ↥X) :
    pi_opens F U ⟶ pi_inters F U :=
  category_theory.limits.pi.lift
    fun (p : ι × ι) =>
      category_theory.limits.pi.π (fun (i : ι) => category_theory.functor.obj F (opposite.op (U i)))
          (prod.fst p) ≫
        category_theory.functor.map F
          (category_theory.has_hom.hom.op
            (topological_space.opens.inf_le_left (U (prod.fst p)) (U (prod.snd p))))

/--
The morphism `Π F.obj (U i) ⟶ Π F.obj (U i) ⊓ (U j)` whose components
are given by the restriction maps from `U j` to `U i ⊓ U j`.
-/
def right_res {C : Type u} [category_theory.category C] [category_theory.limits.has_products C]
    {X : Top} (F : presheaf C X) {ι : Type v} (U : ι → topological_space.opens ↥X) :
    pi_opens F U ⟶ pi_inters F U :=
  category_theory.limits.pi.lift
    fun (p : ι × ι) =>
      category_theory.limits.pi.π (fun (i : ι) => category_theory.functor.obj F (opposite.op (U i)))
          (prod.snd p) ≫
        category_theory.functor.map F
          (category_theory.has_hom.hom.op
            (topological_space.opens.inf_le_right (U (prod.fst p)) (U (prod.snd p))))

/--
The morphism `F.obj U ⟶ Π F.obj (U i)` whose components
are given by the restriction maps from `U j` to `U i ⊓ U j`.
-/
def res {C : Type u} [category_theory.category C] [category_theory.limits.has_products C] {X : Top}
    (F : presheaf C X) {ι : Type v} (U : ι → topological_space.opens ↥X) :
    category_theory.functor.obj F (opposite.op (supr U)) ⟶ pi_opens F U :=
  category_theory.limits.pi.lift
    fun (i : ι) =>
      category_theory.functor.map F
        (category_theory.has_hom.hom.op (topological_space.opens.le_supr U i))

theorem w {C : Type u} [category_theory.category C] [category_theory.limits.has_products C]
    {X : Top} (F : presheaf C X) {ι : Type v} (U : ι → topological_space.opens ↥X) :
    res F U ≫ left_res F U = res F U ≫ right_res F U :=
  sorry

/--
The equalizer diagram for the sheaf condition.
-/
def diagram {C : Type u} [category_theory.category C] [category_theory.limits.has_products C]
    {X : Top} (F : presheaf C X) {ι : Type v} (U : ι → topological_space.opens ↥X) :
    category_theory.limits.walking_parallel_pair ⥤ C :=
  category_theory.limits.parallel_pair (left_res F U) (right_res F U)

/--
The restriction map `F.obj U ⟶ Π F.obj (U i)` gives a cone over the equalizer diagram
for the sheaf condition. The sheaf condition asserts this cone is a limit cone.
-/
def fork {C : Type u} [category_theory.category C] [category_theory.limits.has_products C] {X : Top}
    (F : presheaf C X) {ι : Type v} (U : ι → topological_space.opens ↥X) :
    category_theory.limits.fork (left_res F U) (right_res F U) :=
  category_theory.limits.fork.of_ι (res F U) sorry

@[simp] theorem fork_X {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} (F : presheaf C X) {ι : Type v}
    (U : ι → topological_space.opens ↥X) :
    category_theory.limits.cone.X (fork F U) =
        category_theory.functor.obj F (opposite.op (supr U)) :=
  rfl

@[simp] theorem fork_ι {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} (F : presheaf C X) {ι : Type v}
    (U : ι → topological_space.opens ↥X) : category_theory.limits.fork.ι (fork F U) = res F U :=
  rfl

@[simp] theorem fork_π_app_walking_parallel_pair_zero {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} (F : presheaf C X) {ι : Type v}
    (U : ι → topological_space.opens ↥X) :
    category_theory.nat_trans.app (category_theory.limits.cone.π (fork F U))
          category_theory.limits.walking_parallel_pair.zero =
        res F U :=
  rfl

@[simp] theorem fork_π_app_walking_parallel_pair_one {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} (F : presheaf C X) {ι : Type v}
    (U : ι → topological_space.opens ↥X) :
    category_theory.nat_trans.app (category_theory.limits.cone.π (fork F U))
          category_theory.limits.walking_parallel_pair.one =
        res F U ≫ left_res F U :=
  rfl

/-- Isomorphic presheaves have isomorphic `pi_opens` for any cover `U`. -/
@[simp] def pi_opens.iso_of_iso {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} {F : presheaf C X} {ι : Type v}
    (U : ι → topological_space.opens ↥X) {G : presheaf C X} (α : F ≅ G) :
    pi_opens F U ≅ pi_opens G U :=
  category_theory.limits.pi.map_iso fun (X_1 : ι) => category_theory.iso.app α (opposite.op (U X_1))

/-- Isomorphic presheaves have isomorphic `pi_inters` for any cover `U`. -/
@[simp] def pi_inters.iso_of_iso {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} {F : presheaf C X} {ι : Type v}
    (U : ι → topological_space.opens ↥X) {G : presheaf C X} (α : F ≅ G) :
    pi_inters F U ≅ pi_inters G U :=
  category_theory.limits.pi.map_iso
    fun (X_1 : ι × ι) =>
      category_theory.iso.app α (opposite.op (U (prod.fst X_1) ⊓ U (prod.snd X_1)))

/-- Isomorphic presheaves have isomorphic sheaf condition diagrams. -/
def diagram.iso_of_iso {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} {F : presheaf C X} {ι : Type v}
    (U : ι → topological_space.opens ↥X) {G : presheaf C X} (α : F ≅ G) :
    diagram F U ≅ diagram G U :=
  category_theory.nat_iso.of_components
    (fun (X_1 : category_theory.limits.walking_parallel_pair) =>
      category_theory.limits.walking_parallel_pair.cases_on X_1 (pi_opens.iso_of_iso U α)
        (pi_inters.iso_of_iso U α))
    sorry

/--
If `F G : presheaf C X` are isomorphic presheaves,
then the `fork F U`, the canonical cone of the sheaf condition diagram for `F`,
is isomorphic to `fork F G` postcomposed with the corresponding isomorphism between
sheaf condition diagrams.
-/
def fork.iso_of_iso {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} {F : presheaf C X} {ι : Type v}
    (U : ι → topological_space.opens ↥X) {G : presheaf C X} (α : F ≅ G) :
    fork F U ≅
        category_theory.functor.obj
          (category_theory.limits.cones.postcompose
            (category_theory.iso.inv (diagram.iso_of_iso U α)))
          (fork G U) :=
  category_theory.limits.fork.ext (category_theory.iso.app α (opposite.op (supr U))) sorry

/--
Push forward a cover along an open embedding.
-/
@[simp] def cover.of_open_embedding {X : Top} {ι : Type v} {V : Top} {j : V ⟶ X}
    (oe : open_embedding ⇑j) (𝒰 : ι → topological_space.opens ↥V) :
    ι → topological_space.opens ↥X :=
  fun (i : ι) => category_theory.functor.obj (is_open_map.functor sorry) (𝒰 i)

/--
The isomorphism between `pi_opens` corresponding to an open embedding.
-/
@[simp] def pi_opens.iso_of_open_embedding {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} {F : presheaf C X} {ι : Type v} {V : Top}
    {j : V ⟶ X} (oe : open_embedding ⇑j) (𝒰 : ι → topological_space.opens ↥V) :
    pi_opens
          (category_theory.functor.op
              (is_open_map.functor (pi_opens.iso_of_open_embedding._proof_2 oe)) ⋙
            F)
          𝒰 ≅
        pi_opens F (cover.of_open_embedding oe 𝒰) :=
  category_theory.limits.pi.map_iso
    fun (X_1 : ι) =>
      category_theory.functor.map_iso F
        (category_theory.iso.refl
          (category_theory.functor.obj (category_theory.functor.op (is_open_map.functor sorry))
            (opposite.op (𝒰 X_1))))

/--
The isomorphism between `pi_inters` corresponding to an open embedding.
-/
@[simp] def pi_inters.iso_of_open_embedding {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} {F : presheaf C X} {ι : Type v} {V : Top}
    {j : V ⟶ X} (oe : open_embedding ⇑j) (𝒰 : ι → topological_space.opens ↥V) :
    pi_inters
          (category_theory.functor.op
              (is_open_map.functor (pi_inters.iso_of_open_embedding._proof_2 oe)) ⋙
            F)
          𝒰 ≅
        pi_inters F (cover.of_open_embedding oe 𝒰) :=
  category_theory.limits.pi.map_iso
    fun (X_1 : ι × ι) =>
      category_theory.functor.map_iso F
        (id
          (category_theory.iso.op
            (category_theory.iso.mk (category_theory.hom_of_le sorry)
              (category_theory.hom_of_le sorry))))

/-- The isomorphism of sheaf condition diagrams corresponding to an open embedding. -/
def diagram.iso_of_open_embedding {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} {F : presheaf C X} {ι : Type v} {V : Top}
    {j : V ⟶ X} (oe : open_embedding ⇑j) (𝒰 : ι → topological_space.opens ↥V) :
    diagram
          (category_theory.functor.op
              (is_open_map.functor (diagram.iso_of_open_embedding._proof_2 oe)) ⋙
            F)
          𝒰 ≅
        diagram F (cover.of_open_embedding oe 𝒰) :=
  category_theory.nat_iso.of_components
    (fun (X_1 : category_theory.limits.walking_parallel_pair) =>
      category_theory.limits.walking_parallel_pair.cases_on X_1
        (pi_opens.iso_of_open_embedding oe 𝒰) (pi_inters.iso_of_open_embedding oe 𝒰))
    sorry

/--
If `F : presheaf C X` is a presheaf, and `oe : U ⟶ X` is an open embedding,
then the sheaf condition fork for a cover `𝒰` in `U` for the composition of `oe` and `F` is
isomorphic to sheaf condition fork for `oe '' 𝒰`, precomposed with the isomorphism
of indexing diagrams `diagram.iso_of_open_embedding`.

We use this to show that the restriction of sheaf along an open embedding is still a sheaf.
-/
def fork.iso_of_open_embedding {C : Type u} [category_theory.category C]
    [category_theory.limits.has_products C] {X : Top} {F : presheaf C X} {ι : Type v} {V : Top}
    {j : V ⟶ X} (oe : open_embedding ⇑j) (𝒰 : ι → topological_space.opens ↥V) :
    fork
          (category_theory.functor.op
              (is_open_map.functor (fork.iso_of_open_embedding._proof_2 oe)) ⋙
            F)
          𝒰 ≅
        category_theory.functor.obj
          (category_theory.limits.cones.postcompose
            (category_theory.iso.inv (diagram.iso_of_open_embedding oe 𝒰)))
          (fork F (cover.of_open_embedding oe 𝒰)) :=
  category_theory.limits.fork.ext
    (id
      (category_theory.functor.map_iso F
        (category_theory.iso.op
          (category_theory.iso.mk (category_theory.hom_of_le sorry)
            (category_theory.hom_of_le sorry)))))
    sorry

end Mathlib


abbrev M := ExceptT String <| StateT Nat Id

def f (xs : List Nat) : M Unit := do
for x in xs do
  if x == 0 then
    throw "contains zero"

#eval f [1, 2, 3] |>.run' 0
#eval f [1, 0, 3] |>.run' 0

theorem ex1 : (f [1, 2, 3] |>.run' 0) = Except.ok () :=
rfl

theorem ex2 : (f [1, 0, 3] |>.run' 0) = Except.error "contains zero" :=
rfl

universes u

abbrev N := ExceptT (ULift.{u} String) Id

def idM {α : Type u} (a : α) : N α :=
pure a

def checkEq {α : Type u} [BEq α] [ToString α] (a b : α) : N PUnit := do
unless a == b do
  throw (ULift.up s!"{a} is not equal to {b}")

def g {α : Type u} [BEq α] [ToString α] (xs : List α) (a : α) : N PUnit := do
for x in xs do
  let a ← idM a
  checkEq x a

#eval g [1, (2:Nat), 3] 1 |>.run


import classes.context_free.basics.toolbox
import utilities.list_utils
import utilities.written_by_others.trim_assoc

variables {T : Type}

/-- Context-free grammar for the empty language (i.e., `∈` always gives `false`). -/
def cfg_empty_lang : CF_grammar T :=
CF_grammar.mk (fin 1) 0 []

/-- Characterization of the empty language. -/
lemma language_of_cfg_empty_lang :
  CF_language (@cfg_empty_lang T) = 0 :=
begin
  unfold CF_language,
  ext1 w,
  split, swap,
  {
    intro h,
    exfalso,
    exact set.not_mem_empty w h,
  },
  intro hw,
  change CF_derives cfg_empty_lang [symbol.nonterminal cfg_empty_lang.initial] (list.map symbol.terminal w) at hw,
  exfalso,
  cases CF_tran_or_id_of_deri hw,
  {
    have hhead := congr_fun (congr_arg list.nth h) 0,
    cases w with head tail ih,
    {
      change some (symbol.nonterminal cfg_empty_lang.initial) = none at hhead,
      norm_cast at hhead,
    },
    {
      change some (symbol.nonterminal cfg_empty_lang.initial) = some (symbol.terminal head) at hhead,
      norm_cast at hhead,
    },
  },
  {
    rcases h with ⟨v, ⟨r, rin, -, -, -, -⟩, -⟩,
    cases rin,
  },
end

/-- Context-free grammar for the singleton language that contains `[]` as its only word. -/
def cfg_empty_word : CF_grammar T :=
CF_grammar.mk (fin 1) 0 [(0, [])]

/-- Characterization of the singleton language. -/
lemma language_of_cfg_empty_word :
  CF_language (@cfg_empty_word T) = singleton [] :=
begin
  unfold CF_language,
  ext1 w,
  split, swap,
  {
    intro h,
    rw set.mem_singleton_iff at h,
    change CF_derives cfg_empty_word [symbol.nonterminal cfg_empty_lang.initial] (list.map symbol.terminal w),
    apply @CF_deri_of_tran,
    use ((0 : fin 1), []),
    use [[], []],
    rw h,
    split;
    refl,
    exact T,
  },
  intro hw,
  change
    CF_derives
      (@cfg_empty_word T)
      [symbol.nonterminal (@cfg_empty_lang T).initial]
      (list.map symbol.terminal w)
    at hw,
  cases
    @CF_tran_or_id_of_deri T
      (@cfg_empty_word T)
      [symbol.nonterminal cfg_empty_lang.initial]
      (list.map symbol.terminal w)
      hw,
  {
    exfalso,
    have zeroth := congr_fun (congr_arg list.nth h) 0,
    rw list.nth at zeroth,
    by_cases w = list.nil,
    {
      have is_none : (list.map symbol.terminal w).nth 0 = none,
      {
        rw h,
        rw list.nth_map,
        refl,
      },
      rw is_none at zeroth,
      exact option.no_confusion zeroth,
    },
    {
      have is_terminal : ∃ t, (list.map symbol.terminal w).nth 0 = some (symbol.terminal t),
      {
        apply exists.intro (w.nth_le 0 (list.length_pos_of_ne_nil h)),
        rw list.nth_map,
        norm_num,
        exact list.nth_le_nth (list.length_pos_of_ne_nil h),
      },
      cases is_terminal with irr is_termin,
      rw is_termin at zeroth,
      norm_cast at zeroth,
    },
  },
  rcases h with ⟨v, step_init, step_none⟩,
  have v_is_empty_word : v = list.nil,
  {
    rcases step_init with ⟨r, rin, pre, pos, bef, aft⟩,
    have rule : r = ((0 : fin 1), []),
    {
      rw ←list.mem_singleton,
      exact rin,
    },
    have empty_surrounding : pre = [] ∧ pos = [],
    {
      rw rule at bef,
      have bef_lenghts := congr_arg list.length bef,
      rw list.length_append_append at bef_lenghts,
      rw list.length_singleton at bef_lenghts,
      rw list.length_singleton at bef_lenghts,
      split,
      {
        have pre_zero : pre.length = 0,
        {
          clear_except bef_lenghts,
          linarith,
        },
        rw list.length_eq_zero at pre_zero,
        exact pre_zero,
      },
      {
        have pos_zero : pos.length = 0,
        {
          clear_except bef_lenghts,
          linarith,
        },
        rw list.length_eq_zero at pos_zero,
        exact pos_zero,
      },
    },
    rw empty_surrounding.1 at aft,
    rw empty_surrounding.2 at aft,
    rw rule at aft,
    exact aft,
  },
  rw v_is_empty_word at step_none,
  cases
    @CF_tran_or_id_of_deri T
      (@cfg_empty_word T)
      list.nil
      (list.map symbol.terminal w)
      step_none,
  {
    by_contradiction contra,
    have w_not_nil : w.length > 0,
    {
      apply list.length_pos_of_ne_nil,
      convert contra,
    },
    have impossible_lengths := congr_arg list.length h,
    rw list.length at impossible_lengths,
    rw list.length_map at impossible_lengths,
    rw ←impossible_lengths at w_not_nil,
    exact nat.lt_irrefl 0 w_not_nil,
  },
  {
    exfalso,
    rcases h with ⟨-, ⟨trash_r, -, trash_1, trash_2, impossible, -⟩, -⟩,
    have impossible_len := congr_arg list.length impossible,
    clear_except impossible_len,
    rw list.length_append_append at impossible_len,
    rw list.length_singleton at impossible_len,
    rw list.length at impossible_len,
    linarith,
  },
end

/-- Context-free grammar for a language `{a}.star` where `a` is a given terminal symbol. -/
def cfg_symbol_star (a : T) : CF_grammar T :=
CF_grammar.mk (fin 1) 0 [(0, [symbol.terminal a, symbol.nonterminal 0]), (0, [])]

/-- Characterization of the `{a}.star` language. -/
lemma language_of_cfg_symbol_star (a : T) :
  CF_language (cfg_symbol_star a) = λ w, ∃ n : ℕ, w = list.repeat a n :=
begin
  apply set.eq_of_subset_of_subset,
  {
    intro w,
    /-
      We prove this inclusion as follows:
      (1) `w ∈ CF_language (cfg_symbol_star a)` →
      (2) `w` contains only `a`s →
      (3) `∃ (n : ℕ), w = list.repeat a n)` □
    -/

    have implication2 : (∀ t : T, t ≠ a → t ∉ w) → (∃ (n : ℕ), w = list.repeat a n),
    {
      contrapose,
      intros contr ass,
      push_neg at contr,
      specialize contr w.length,

      have different :
        ∃ n : ℕ, ∃ hl : n < w.length, ∃ hr : n < (list.repeat a w.length).length,
          w.nth_le n hl ≠ (list.repeat a w.length).nth_le n hr,
      {
        by_contradiction isnt,
        have same_len : w.length = (list.repeat a w.length).length,
        {
          rw list.length_repeat,
        },
        apply contr,
        apply list.ext_le same_len,
        push_neg at isnt,
        intros n n_small_left n_small_right,
        specialize isnt n n_small_left,
        push_neg at isnt,
        specialize isnt n_small_right,
        push_neg at isnt,
        exact isnt,
      },
      rcases different with ⟨n, hl, hr, nq⟩,

      rw list.nth_le_repeat a hr at nq,
      specialize ass (w.nth_le n hl) nq,
      exact ass (list.nth_le_mem w n hl),
    },

    have implication1 : w ∈ CF_language (cfg_symbol_star a) → (∀ t : T, t ≠ a → t ∉ w),
    {
      clear implication2,
      intros ass t nq,
      change CF_generates_str (cfg_symbol_star a) (list.map symbol.terminal w) at ass,
      unfold CF_generates_str at ass,

      have indu :
        ∀ v : list (symbol T (cfg_symbol_star a).nt),
          CF_derives (cfg_symbol_star a) [symbol.nonterminal (cfg_symbol_star a).initial] v →
            symbol.terminal t ∉ v,
      {
        intros v hyp,
        induction hyp with x y trash orig ih,
        {
          clear_except,
          rw list.mem_singleton,
          apply symbol.no_confusion,
        },
        rcases orig with ⟨r, rin, p, q, bef, aft⟩,
        rw aft,
        rw bef at ih,
        repeat {
          rw list.mem_append at *,
        },
        push_neg,
        push_neg at ih,
        split, swap,
        {
          exact ih.right,
        },
        split,
        {
          exact ih.left.left,
        },
        cases rin,
        {
          rw rin,
          dsimp only,
          intro imposs,
          cases imposs,
          {
            apply nq,
            exact symbol.terminal.inj imposs,
          },
          cases imposs,
          {
            norm_cast at imposs,
          },
          exact list.not_mem_nil (@symbol.terminal T (cfg_symbol_star a).nt t) imposs,
        },
        {
          change r ∈ [((0 : fin 1), ([] : list (symbol T (cfg_symbol_star a).nt)))] at rin,
          rw list.mem_singleton at rin,
          rw rin,
          exact list.not_mem_nil (symbol.terminal t),
        }
      },
      specialize indu (list.map symbol.terminal w) ass,

      by_contradiction contra,
      exact indu (list.mem_map_of_mem symbol.terminal contra),
    },

    exact implication2 ∘ implication1,
  },
  {
    intros w hw,
    cases hw with n hwn,
    rw hwn,
    convert_to CF_generates_str (cfg_symbol_star a) (list.map symbol.terminal (list.repeat a n)),
    unfold CF_generates_str,
    clear hwn w,
    have comes_to :
      CF_derives
        (cfg_symbol_star a)
        [symbol.nonterminal (cfg_symbol_star a).initial]
        (list.repeat (symbol.terminal a) n ++ [symbol.nonterminal (0 : fin 1)]),
    {
      induction n with n ih,
      {
        apply CF_deri_self,
      },
      apply CF_deri_of_deri_tran ih,
      use ((0 : fin 1), [symbol.terminal a, symbol.nonterminal (0 : fin 1)]),
      split,
      {
        apply list.mem_cons_self,
      },
      use [list.repeat (symbol.terminal a) n, []],
      split,
      {
        rw list.append_nil,
      },
      rw list.append_nil,
      change
        symbol.terminal a :: (list.repeat (symbol.terminal a) n ++ [symbol.nonterminal (0 : fin 1)]) =
        list.repeat (symbol.terminal a) n ++ ([symbol.terminal a] ++ [symbol.nonterminal 0]),
      rw ←list.cons_append,
      trim,
      have count_succ_left :
        @symbol.terminal T (fin 1) a :: list.repeat (symbol.terminal a) n =
        list.repeat (symbol.terminal a) (n + 1),
      {
        symmetry,
        apply list.repeat_succ,
      },
      have count_succ_right :
        list.repeat (symbol.terminal a) n ++ [symbol.terminal a] =
        list.repeat (symbol.terminal a) (n + 1),
      {
        change
          list.repeat (symbol.terminal a) n ++ list.repeat (symbol.terminal a) 1 =
          list.repeat (symbol.terminal a) (n + 1),
        symmetry,
        apply list.repeat_add,
      },
      rw count_succ_left,
      rw count_succ_right,
    },
    apply CF_deri_of_deri_tran comes_to,
    use ((0 : fin 1), []),
    split,
    {
      apply list.mem_cons_of_mem,
      apply list.mem_cons_self,
    },
    use [list.repeat (symbol.terminal a) n, []],
    split;
    simp,
  }
end


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Simon Hudon
-/
import category_theory.monoidal.braided
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.terminal

/-!
# The natural monoidal structure on any category with finite (co)products.

A category with a monoidal structure provided in this way
is sometimes called a (co)cartesian category,
although this is also sometimes used to mean a finitely complete category.
(See <https://ncatlab.org/nlab/show/cartesian+category>.)

As this works with either products or coproducts,
and sometimes we want to think of a different monoidal structure entirely,
we don't set up either construct as an instance.

## Implementation
We had previously chosen to rely on `has_terminal` and `has_binary_products` instead of
`has_finite_products`, because we were later relying on the definitional form of the tensor product.
Now that `has_limit` has been refactored to be a `Prop`,
this issue is irrelevant and we could simplify the construction here.

See `category_theory.monoidal.of_chosen_finite_products` for a variant of this construction
which allows specifying a particular choice of terminal object and binary products.
-/

universes v u

noncomputable theory

namespace category_theory

variables (C : Type u) [category.{v} C] {X Y : C}

open category_theory.limits

section
local attribute [tidy] tactic.case_bash

/-- A category with a terminal object and binary products has a natural monoidal structure. -/
def monoidal_of_has_finite_products [has_terminal C] [has_binary_products C] :
  monoidal_category C :=
{ tensor_unit  := ⊤_ C,
  tensor_obj   := λ X Y, X ⨯ Y,
  tensor_hom   := λ _ _ _ _ f g, limits.prod.map f g,
  associator   := prod.associator,
  left_unitor  := λ P, prod.left_unitor P,
  right_unitor := λ P, prod.right_unitor P,
  pentagon'    := prod.pentagon,
  triangle'    := prod.triangle,
  associator_naturality' := @prod.associator_naturality _ _ _, }
end

section
local attribute [instance] monoidal_of_has_finite_products

open monoidal_category

/--
The monoidal structure coming from finite products is symmetric.
-/
@[simps]
def symmetric_of_has_finite_products [has_terminal C] [has_binary_products C] :
  symmetric_category C :=
{ braiding := λ X Y, limits.prod.braiding X Y,
  braiding_naturality' := λ X X' Y Y' f g,
    by { dsimp [tensor_hom], simp, },
  hexagon_forward' := λ X Y Z,
    by { dsimp [monoidal_of_has_finite_products], simp },
  hexagon_reverse' := λ X Y Z,
    by { dsimp [monoidal_of_has_finite_products], simp },
  symmetry' := λ X Y, by { dsimp, simp, refl, }, }

end

namespace monoidal_of_has_finite_products

variables [has_terminal C] [has_binary_products C]
local attribute [instance] monoidal_of_has_finite_products

@[simp]
lemma tensor_obj (X Y : C) : X ⊗ Y = (X ⨯ Y) := rfl
@[simp]
lemma tensor_hom {W X Y Z : C} (f : W ⟶ X) (g : Y ⟶ Z) : f ⊗ g = limits.prod.map f g := rfl

@[simp]
lemma left_unitor_hom (X : C) : (λ_ X).hom = limits.prod.snd := rfl
@[simp]
lemma left_unitor_inv (X : C) : (λ_ X).inv = prod.lift (terminal.from X) (𝟙 _) := rfl
@[simp]
lemma right_unitor_hom (X : C) : (ρ_ X).hom = limits.prod.fst := rfl
@[simp]
lemma right_unitor_inv (X : C) : (ρ_ X).inv = prod.lift (𝟙 _) (terminal.from X) := rfl
-- We don't mark this as a simp lemma, even though in many particular
-- categories the right hand side will simplify significantly further.
-- For now, we'll plan to create specialised simp lemmas in each particular category.
lemma associator_hom (X Y Z : C) :
  (α_ X Y Z).hom =
  prod.lift
    (limits.prod.fst ≫ limits.prod.fst)
    (prod.lift (limits.prod.fst ≫ limits.prod.snd) limits.prod.snd) := rfl

end monoidal_of_has_finite_products

section
local attribute [tidy] tactic.case_bash

/-- A category with an initial object and binary coproducts has a natural monoidal structure. -/
def monoidal_of_has_finite_coproducts [has_initial C] [has_binary_coproducts C] :
  monoidal_category C :=
{ tensor_unit  := ⊥_ C,
  tensor_obj   := λ X Y, X ⨿ Y,
  tensor_hom   := λ _ _ _ _ f g, limits.coprod.map f g,
  associator   := coprod.associator,
  left_unitor  := coprod.left_unitor,
  right_unitor := coprod.right_unitor,
  pentagon'    := coprod.pentagon,
  triangle'    := coprod.triangle,
  associator_naturality' := @coprod.associator_naturality _ _ _, }
end

section
local attribute [instance] monoidal_of_has_finite_coproducts

open monoidal_category

/--
The monoidal structure coming from finite coproducts is symmetric.
-/
@[simps]
def symmetric_of_has_finite_coproducts [has_initial C] [has_binary_coproducts C] :
  symmetric_category C :=
{ braiding := limits.coprod.braiding,
  braiding_naturality' := λ X X' Y Y' f g,
    by { dsimp [tensor_hom], simp, },
  hexagon_forward' := λ X Y Z,
    by { dsimp [monoidal_of_has_finite_coproducts], simp },
  hexagon_reverse' := λ X Y Z,
    by { dsimp [monoidal_of_has_finite_coproducts], simp },
  symmetry' := λ X Y, by { dsimp, simp, refl, }, }

end

namespace monoidal_of_has_finite_coproducts

variables [has_initial C] [has_binary_coproducts C]
local attribute [instance] monoidal_of_has_finite_coproducts

@[simp]
lemma tensor_obj (X Y : C) : X ⊗ Y = (X ⨿ Y) := rfl
@[simp]
lemma tensor_hom {W X Y Z : C} (f : W ⟶ X) (g : Y ⟶ Z) : f ⊗ g = limits.coprod.map f g := rfl

@[simp]
lemma left_unitor_hom (X : C) : (λ_ X).hom = coprod.desc (initial.to X) (𝟙 _) := rfl
@[simp]
lemma right_unitor_hom (X : C) : (ρ_ X).hom = coprod.desc (𝟙 _) (initial.to X) := rfl
@[simp]
lemma left_unitor_inv (X : C) : (λ_ X).inv = limits.coprod.inr := rfl
@[simp]
lemma right_unitor_inv (X : C) : (ρ_ X).inv = limits.coprod.inl := rfl
-- We don't mark this as a simp lemma, even though in many particular
-- categories the right hand side will simplify significantly further.
-- For now, we'll plan to create specialised simp lemmas in each particular category.
lemma associator_hom (X Y Z : C) :
  (α_ X Y Z).hom =
  coprod.desc
    (coprod.desc coprod.inl (coprod.inl ≫ coprod.inr))
    (coprod.inr ≫ coprod.inr) := rfl

end monoidal_of_has_finite_coproducts

end category_theory


import Std.Tactic.Lint
open Std.Tactic.Lint
set_option linter.missingDocs false

def f : Nat := 0
def g : Nat := 0
def h : Nat := 0
@[simp] theorem fg : f = g := rfl
@[simp] theorem fh : f = h := rfl
#eval do guard (← [``fg, ``fh].anyM fun n => return (← simpNF.test n).isSome)

@[simp] theorem and_comm : a ∧ b ↔ b ∧ a := And.comm
#eval do guard (← simpComm.test ``and_comm).isSome

@[simp] theorem Prod.mk_fst : (a, b).1 = id a := rfl
#eval do guard (← simpVarHead.test ``Prod.mk_fst).isSome

def SemiconjBy [Mul M] (a x y : M) : Prop :=
  a * x = y * a

structure MulOpposite (α : Type u) : Type u where
  op :: unop : α

postfix:max "ᵐᵒᵖ" => MulOpposite

namespace MulOpposite

instance [Mul α] : Mul αᵐᵒᵖ where mul x y := op (unop y * unop x)

@[simp]
theorem unop_inj {x y : αᵐᵒᵖ} : unop x = unop y ↔ x = y := by
  cases x; cases y; simp

@[simp]
theorem semiconj_by_unop [Mul α] {a x y : αᵐᵒᵖ} :
    SemiconjBy (unop a) (unop y) (unop x) ↔ SemiconjBy a x y := sorry

#eval do guard (← simpComm.test ``unop_inj).isNone
#eval do guard (← simpComm.test ``semiconj_by_unop).isNone

end MulOpposite


lemma contrapositive2 (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) :=
begin

end


example (P Q : Prop) (HP : P) (HPQ : P → Q) : Q := HPQ HP -- HPQ is a function!