import tactic
import data.real.basic
import data.set
import data.set.lattice
import tactic
import logics

namespace tactic.interactive
open lean.parser tactic interactive
open tactic expr

local postfix *:9001 := many

/- Tente de réécrire le but ou une hypothèse avec un lemme du type "definitions.***"
dans le sens direct, puis dans le sens réciproque -/
-- Ammélioration : utilisation parse location, cf mathlib doc
-- Amélioration vitale : cibler une occurence de la définition
-- Amélioration : pouvoir passer deux hypothèses (ou plus) qui seront combinées en P ∧ Q ; problème =
-- comment les combiner dans le bon ordre ?
-- Amélioration : essayer successivement toutes les versions d'un lemme,
-- terminant par un numéro, e g intersection_2, intersection_ensemble
meta def defi (name : parse ident) (at_hypo : parse (optional (tk "at" *> ident)))
                            : tactic unit :=
do
    let name := "definitions" <.> to_string name,
    trace ("J'appelle le lemme " ++ to_string name ++ ","),
    expr ← mk_const name,
    -- expr ← get_local name,
    -- expr ← (to_expr ``(%%name)),
    match at_hypo with
    | none :=  do {rewrite_target expr, trace "sur le but, sens direct"}
            <|>  do {rewrite_target expr {symm := tt},
                    trace "sur le but, sens réciproque"}
 --   | `(tk "at" %%hypo) := skip,
    | some hypo := do e ← get_local hypo,
                    do {rewrite_hyp expr e,
                 trace ("sur l'hypothèse " ++ (to_string hypo) ++", sens direct")}
                <|>  do {rewrite_hyp expr e {symm := tt},
                 trace ("sur l'hypothèse " ++ (to_string hypo) ++", sens réciproque")}
    end

-- à AMELIORER : essayer simp only si ça rate
meta def applique (names : parse ident*) : tactic unit :=
match names with
    | [H1,H2] := do
         nom_hyp ← get_unused_name `H,
        n1 ← get_local H1,
        n2 ← get_local H2,
        «have» nom_hyp none ``(%%n1 %%n2)
    | _ := fail "Il faut deux paramètres exactement"
    end

-- à AMELIORER
meta def appliquetheo (names : parse ident*) : tactic unit :=
match names with
    | [name,H2] := do
         nom_hyp ← get_unused_name `H,
        let name := "theoremes" <.> to_string name,
        n1 ← mk_const name,
        n2 ← get_local H2,
    «have» nom_hyp none ``(%%n1 %%n2)
    | _ := fail "Il faut deux paramètres exactement"
    end

end tactic.interactive

------------- Lemmes définitionnels ---------------
namespace definitions

------------ Théorie des ensembles --------------
section theorie_des_ensembles

variables {X : Type} {Y : Type}
-- mem_compl_iff
--lemma complement {A : set X} {x : X} : x ∈ - A ↔ ¬ x ∈ A :=
--iff.rfl

lemma complement {A : set X} {x : X} : x ∈ set.univ \ A ↔ x ∉ A :=
by finish

lemma complement_1 {A : set X} {x : X} : x ∈ set.compl A ↔ x ∉ A :=
by finish

lemma complement_2 {A B : set X} {x : X} : x ∈ B \ A ↔ (x ∈ B ∧ x ∉ A) :=
iff.rfl

lemma inclusion (A B : set X) : A ⊆ B ↔ ∀ {{x:X}}, x ∈ A → x ∈ B :=
iff.rfl

lemma intersection_deux  (A B : set X) (x : X) :  x ∈ A ∩ B ↔ ( x ∈ A ∧ x ∈ B) :=
iff.rfl

-- bof : ce n'est pas une définition, mais une caractérisation
lemma intersection_ensemble  (A B C : set X) : C ⊆ A ∩ B ↔ C ⊆ A ∧ C ⊆ B :=
begin
    exact ball_and_distrib
end

lemma intersection_quelconque (I : Type) (O : I → set X)  (x : X) : (x ∈ set.Inter O) ↔ (∀ i:I, x ∈ O i) :=
set.mem_Inter

-- Les deux lemmes suivants seront à regroupé au sein d'une même tactique : essayer le premier,
-- en cas d'échec essayer le second. Un seul bouton dans l'interface graphique
lemma union  (A : set X) (B : set X) (x : X) :  x ∈ A ∪ B ↔ ( x ∈ A ∨ x ∈ B) :=
iff.rfl

lemma union_quelconque (I : Type) (O : I → set X)  (x : X) : (x ∈ set.Union O) ↔ (∃ i:I, x ∈ O i) :=
set.mem_Union

-- mem_image_iff_bex
lemma image  (A : set X)  (f : X → Y) (b : Y) : b ∈ f '' A ↔  ∃ a, a ∈ A ∧ f(a) = b :=
begin
    tidy,
end

lemma image_reciproque  {B : set Y}  {f : X → Y} {a : X} :
                             a ∈ f ⁻¹' B ↔  f a ∈ B :=
                             iff.rfl

lemma ensemble_egal {A A' : set X} : (A = A') ↔ ( ∀ x, x ∈ A ↔ x ∈ A' ) :=
by exact set.ext_iff

lemma double_inclusion {A A' : set X} : (A = A') ↔ (A ⊆ A' ∧ A' ⊆ A) :=
begin
    exact le_antisymm_iff
end

end theorie_des_ensembles

-------------------- LOGIQUE -----------------------
section logique
lemma double_implication (P Q : Prop) : (P ↔ Q) ↔ (P → Q) ∧ (Q → P) := by tautology

end logique

set_option trace.simplify.rewrite true
-- set_option pp.all true
------------------ Nombres -------------------
section nombres
lemma minimum (a b m :ℝ) : m = min a b ↔ (m=a ∨ m=b) ∧ m ≤ a ∧ m ≤ b :=
begin
by_cases a ≤ b,
    simp only [h, min_eq_left],
    split, intro H, rw H, finish,
    finish,

push_neg at h,
have H : min a b = b, by exact min_eq_right_of_lt h,
rw H,
    split,
    intro H', split,
        finish,
    rw H', split, linarith only [h],
    exact le_refl b,
rintro ⟨ H1, H2, H3 ⟩,
cases H1 with Ha Hb,
    exfalso,
    rw Ha at H3,
    linarith only [h, H3],
assumption
end

end nombres
------------------ Topologie -------------------

------------------------------------------------
end definitions


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.big_operators.basic
import algebra.big_operators.pi
import category_theory.limits.shapes.biproducts
import category_theory.preadditive
import category_theory.preadditive.additive_functor
import data.matrix.dmatrix
import data.matrix.basic
import category_theory.Fintype
import category_theory.preadditive.single_obj
import algebra.opposites

/-!
# Matrices over a category.

When `C` is a preadditive category, `Mat_ C` is the preadditive category
whose objects are finite tuples of objects in `C`, and
whose morphisms are matrices of morphisms from `C`.

There is a functor `Mat_.embedding : C ⥤ Mat_ C` sending morphisms to one-by-one matrices.

`Mat_ C` has finite biproducts.

## The additive envelope

We show that this construction is the "additive envelope" of `C`,
in the sense that any additive functor `F : C ⥤ D` to a category `D` with biproducts
lifts to a functor `Mat_.lift F : Mat_ C ⥤ D`,
Moreover, this functor is unique (up to natural isomorphisms) amongst functors `L : Mat_ C ⥤ D`
such that `embedding C ⋙ L ≅ F`.
(As we don't have 2-category theory, we can't explicitly state that `Mat_ C` is
the initial object in the 2-category of categories under `C` which have biproducts.)

As a consequence, when `C` already has finite biproducts we have `Mat_ C ≌ C`.

## Future work

We should provide a more convenient `Mat R`, when `R` is a ring,
as a category with objects `n : FinType`,
and whose morphisms are matrices with components in `R`.

Ideally this would conveniently interact with both `Mat_` and `matrix`.

-/

open category_theory category_theory.preadditive
open_locale big_operators classical
noncomputable theory

namespace category_theory

universes w v₁ v₂ u₁ u₂
variables (C : Type u₁) [category.{v₁} C] [preadditive C]

/--
An object in `Mat_ C` is a finite tuple of objects in `C`.
-/
structure Mat_ :=
(ι : Type)
[F : fintype ι]
(X : ι → C)

attribute [instance] Mat_.F

namespace Mat_

variables {C}

/-- A morphism in `Mat_ C` is a dependently typed matrix of morphisms. -/
@[nolint has_inhabited_instance]
def hom (M N : Mat_ C) : Type v₁ := dmatrix M.ι N.ι (λ i j, M.X i ⟶ N.X j)

namespace hom

/-- The identity matrix consists of identity morphisms on the diagonal, and zeros elsewhere. -/
def id (M : Mat_ C) : hom M M := λ i j, if h : i = j then eq_to_hom (congr_arg M.X h) else 0

/-- Composition of matrices using matrix multiplication. -/
def comp {M N K : Mat_ C} (f : hom M N) (g : hom N K) : hom M K :=
λ i k, ∑ j : N.ι, f i j ≫ g j k

end hom

section
local attribute [simp] hom.id hom.comp

instance : category.{v₁} (Mat_ C) :=
{ hom := hom,
  id := hom.id,
  comp := λ M N K f g, f.comp g,
  id_comp' := λ M N f, by simp [dite_comp],
  comp_id' := λ M N f, by simp [comp_dite],
  assoc' := λ M N K L f g h, begin
    ext i k,
    simp_rw [hom.comp, sum_comp, comp_sum, category.assoc],
    rw finset.sum_comm,
  end, }.

lemma id_def (M : Mat_ C) :
  (𝟙 M : hom M M) = λ i j, if h : i = j then eq_to_hom (congr_arg M.X h) else 0 :=
rfl

lemma id_apply (M : Mat_ C) (i j : M.ι) :
  (𝟙 M : hom M M) i j = if h : i = j then eq_to_hom (congr_arg M.X h) else 0 :=
rfl

@[simp] lemma id_apply_self (M : Mat_ C) (i : M.ι) :
  (𝟙 M : hom M M) i i = 𝟙 _ :=
by simp [id_apply]

@[simp] lemma id_apply_of_ne (M : Mat_ C) (i j : M.ι) (h : i ≠ j) :
  (𝟙 M : hom M M) i j = 0 :=
by simp [id_apply, h]

lemma comp_def {M N K : Mat_ C} (f : M ⟶ N) (g : N ⟶ K) :
  (f ≫ g) = λ i k, ∑ j : N.ι, f i j ≫ g j k := rfl

@[simp] lemma comp_apply {M N K : Mat_ C} (f : M ⟶ N) (g : N ⟶ K) (i k) :
  (f ≫ g) i k = ∑ j : N.ι, f i j ≫ g j k := rfl

instance (M N : Mat_ C) : inhabited (M ⟶ N) := ⟨λ i j, (0 : M.X i ⟶ N.X j)⟩

end

instance : preadditive (Mat_ C) :=
{ hom_group := λ M N, by { change add_comm_group (dmatrix M.ι N.ι _), apply_instance, },
  add_comp' := λ M N K f f' g, by { ext, simp [finset.sum_add_distrib], },
  comp_add' := λ M N K f g g', by { ext, simp [finset.sum_add_distrib], }, }

@[simp] lemma add_apply {M N : Mat_ C} (f g : M ⟶ N) (i j) : (f + g) i j = f i j + g i j := rfl

open category_theory.limits

/--
We now prove that `Mat_ C` has finite biproducts.

Be warned, however, that `Mat_ C` is not necessarily Krull-Schmidt,
and so the internal indexing of a biproduct may have nothing to do with the external indexing,
even though the construction we give uses a sigma type.
See however `iso_biproduct_embedding`.
-/
instance has_finite_biproducts : has_finite_biproducts (Mat_ C) :=
{ has_biproducts_of_shape := λ J 𝒟, by exactI
  { has_biproduct := λ f,
    has_biproduct_of_total
    { X := ⟨Σ j : J, (f j).ι, λ p, (f p.1).X p.2⟩,
      π := λ j x y,
      begin
        dsimp at x ⊢,
        refine if h : x.1 = j then _ else 0,
        refine if h' : (@eq.rec J x.1 (λ j, (f j).ι) x.2 _ h) = y then _ else 0,
        apply eq_to_hom,
        substs h h', -- Notice we were careful not to use `subst` until we had a goal in `Prop`.
      end,
      ι := λ j x y,
      begin
        dsimp at y ⊢,
        refine if h : y.1 = j then _ else 0,
        refine if h' : (@eq.rec J y.1 (λ j, (f j).ι) y.2 _ h) = x then _ else 0,
        apply eq_to_hom,
        substs h h',
      end,
      ι_π := λ j j',
      begin
        ext x y,
        dsimp,
        simp_rw [dite_comp, comp_dite],
        simp only [if_t_t, dite_eq_ite, dif_ctx_congr, limits.comp_zero, limits.zero_comp,
          eq_to_hom_trans, finset.sum_congr],
        erw finset.sum_sigma,
        dsimp,
        simp only [if_congr, if_true, dif_ctx_congr, finset.sum_dite_irrel, finset.mem_univ,
          finset.sum_const_zero, finset.sum_congr, finset.sum_dite_eq'],
        split_ifs with h h',
        { substs h h',
          simp only [category_theory.eq_to_hom_refl, category_theory.Mat_.id_apply_self], },
        { subst h,
          simp only [id_apply_of_ne _ _ _ h', category_theory.eq_to_hom_refl], },
        { refl, },
      end, }
    begin
      dsimp,
      funext i₁,
      dsimp at i₁ ⊢,
      rcases i₁ with ⟨j₁, i₁⟩,
      -- I'm not sure why we can't just `simp` by `finset.sum_apply`: something doesn't quite match
      convert finset.sum_apply _ _ _ using 1,
      { refl, },
      { apply heq_of_eq,
        symmetry,
        funext i₂,
        rcases i₂ with ⟨j₂, i₂⟩,
        simp only [comp_apply, dite_comp, comp_dite,
          if_t_t, dite_eq_ite, if_congr, if_true, dif_ctx_congr,
          finset.sum_dite_irrel, finset.sum_dite_eq, finset.mem_univ, finset.sum_const_zero,
          finset.sum_congr, finset.sum_dite_eq, finset.sum_apply,
          limits.comp_zero, limits.zero_comp, eq_to_hom_trans, Mat_.id_apply],
        by_cases h : j₁ = j₂,
        { subst h, simp, },
        { simp [h], }, },
    end }}.

end Mat_

namespace functor
variables {C} {D : Type*} [category.{v₁} D] [preadditive D]

local attribute [simp] Mat_.id_apply eq_to_hom_map

/--
A functor induces a functor of matrix categories.
-/
@[simps]
def map_Mat_ (F : C ⥤ D) [functor.additive F] : Mat_ C ⥤ Mat_ D :=
{ obj := λ M, ⟨M.ι, λ i, F.obj (M.X i)⟩,
  map := λ M N f i j, F.map (f i j),
  map_comp' := λ M N K f g, by { ext i k, simp,}, }

/--
The identity functor induces the identity functor on matrix categories.
-/
@[simps]
def map_Mat_id : (𝟭 C).map_Mat_ ≅ 𝟭 (Mat_ C) :=
nat_iso.of_components (λ M, eq_to_iso (by { cases M, refl, }))
(λ M N f, begin
  ext i j,
  cases M, cases N,
  simp [comp_dite, dite_comp],
end)

/--
Composite functors induce composite functors on matrix categories.
-/
@[simps]
def map_Mat_comp {E : Type*} [category.{v₁} E] [preadditive E]
  (F : C ⥤ D) [functor.additive F] (G : D ⥤ E) [functor.additive G] :
  (F ⋙ G).map_Mat_ ≅ F.map_Mat_ ⋙ G.map_Mat_ :=
nat_iso.of_components (λ M, eq_to_iso (by { cases M, refl, }))
(λ M N f, begin
  ext i j,
  cases M, cases N,
  simp [comp_dite, dite_comp],
end)

end functor

namespace Mat_

variables (C)

/-- The embedding of `C` into `Mat_ C` as one-by-one matrices.
(We index the summands by `punit`.) -/
@[simps]
def embedding : C ⥤ Mat_ C :=
{ obj := λ X, ⟨punit, λ _, X⟩,
  map := λ X Y f, λ _ _, f,
  map_id' := λ X, by { ext ⟨⟩ ⟨⟩, simp, },
  map_comp' := λ X Y Z f g, by { ext ⟨⟩ ⟨⟩, simp, }, }

namespace embedding

instance : faithful (embedding C) :=
{ map_injective' := λ X Y f g h, congr_fun (congr_fun h punit.star) punit.star, }

instance : full (embedding C) :=
{ preimage := λ X Y f, f punit.star punit.star, }

instance : functor.additive (embedding C) := {}

end embedding

instance [inhabited C] : inhabited (Mat_ C) := ⟨(embedding C).obj default⟩

open category_theory.limits

variables {C}

/--
Every object in `Mat_ C` is isomorphic to the biproduct of its summands.
-/
@[simps]
def iso_biproduct_embedding (M : Mat_ C) : M ≅ ⨁ (λ i, (embedding C).obj (M.X i)) :=
{ hom := biproduct.lift (λ i j k, if h : j = i then eq_to_hom (congr_arg M.X h) else 0),
  inv := biproduct.desc (λ i j k, if h : i = k then eq_to_hom (congr_arg M.X h) else 0),
  hom_inv_id' :=
  begin
    simp only [biproduct.lift_desc],
    funext i,
    dsimp,
    convert finset.sum_apply _ _ _,
    { dsimp, refl, },
    { apply heq_of_eq,
      symmetry,
      funext j,
      simp only [finset.sum_apply],
      dsimp,
      simp [dite_comp, comp_dite, Mat_.id_apply], }
  end,
  inv_hom_id' :=
  begin
    apply biproduct.hom_ext,
    intro i,
    apply biproduct.hom_ext',
    intro j,
    simp only [category.id_comp, category.assoc,
      biproduct.lift_π, biproduct.ι_desc_assoc, biproduct.ι_π],
    ext ⟨⟩ ⟨⟩,
    simp [dite_comp, comp_dite],
    split_ifs,
    { subst h, simp, },
    { simp [h], },
  end, }.

variables {D : Type u₁} [category.{v₁} D] [preadditive D]

/-- Every `M` is a direct sum of objects from `C`, and `F` preserves biproducts. -/
@[simps]
def additive_obj_iso_biproduct (F : Mat_ C ⥤ D) [functor.additive F] (M : Mat_ C) :
  F.obj M ≅ ⨁ (λ i, F.obj ((embedding C).obj (M.X i))) :=
(F.map_iso (iso_biproduct_embedding M)) ≪≫ (F.map_biproduct _)

variables [has_finite_biproducts D]

@[reassoc] lemma additive_obj_iso_biproduct_naturality (F : Mat_ C ⥤ D) [functor.additive F]
  {M N : Mat_ C} (f : M ⟶ N) :
  F.map f ≫ (additive_obj_iso_biproduct F N).hom =
    (additive_obj_iso_biproduct F M).hom ≫
      biproduct.matrix (λ i j, F.map ((embedding C).map (f i j))) :=
begin
  -- This is disappointingly tedious.
  ext,
  simp only [additive_obj_iso_biproduct_hom, category.assoc, biproduct.lift_π, functor.map_bicone_π,
    biproduct.bicone_π, biproduct.lift_matrix],
  dsimp [embedding],
  simp only [←F.map_comp, biproduct.lift_π, biproduct.matrix_π, category.assoc],
  simp only [←F.map_comp, ←F.map_sum, biproduct.lift_desc, biproduct.lift_π_assoc, comp_sum],
  simp only [comp_def, comp_dite, comp_zero, finset.sum_dite_eq', finset.mem_univ, if_true],
  dsimp,
  simp only [finset.sum_singleton, dite_comp, zero_comp],
  congr,
  symmetry,
  convert finset.sum_fn _ _, -- It's hard to use this as a simp lemma!
  simp only [finset.sum_fn, finset.sum_dite_eq],
  ext,
  simp,
end

@[reassoc] lemma additive_obj_iso_biproduct_naturality' (F : Mat_ C ⥤ D) [functor.additive F]
  {M N : Mat_ C} (f : M ⟶ N) :
  (additive_obj_iso_biproduct F M).inv ≫ F.map f =
    biproduct.matrix (λ i j, F.map ((embedding C).map (f i j)) : _) ≫
      (additive_obj_iso_biproduct F N).inv :=
by rw [iso.inv_comp_eq, ←category.assoc, iso.eq_comp_inv, additive_obj_iso_biproduct_naturality]

/-- Any additive functor `C ⥤ D` to a category `D` with finite biproducts extends to
a functor `Mat_ C ⥤ D`. -/
@[simps]
def lift (F : C ⥤ D) [functor.additive F] : Mat_ C ⥤ D :=
{ obj := λ X, ⨁ (λ i, F.obj (X.X i)),
  map := λ X Y f, biproduct.matrix (λ i j, F.map (f i j)),
  map_id' := λ X, begin
    ext i j,
    by_cases h : i = j,
    { subst h, simp, },
    { simp [h, Mat_.id_apply], },
  end,
  map_comp' := λ X Y Z f g, by { ext i j, simp, }, }.

instance lift_additive (F : C ⥤ D) [functor.additive F] : functor.additive (lift F) := {}

/-- An additive functor `C ⥤ D` factors through its lift to `Mat_ C ⥤ D`. -/
@[simps]
def embedding_lift_iso (F : C ⥤ D) [functor.additive F] : embedding C ⋙ lift F ≅ F :=
nat_iso.of_components (λ X,
  { hom := biproduct.desc (λ P, 𝟙 (F.obj X)),
    inv := biproduct.lift (λ P, 𝟙 (F.obj X)), })
(λ X Y f, begin
  dsimp,
  ext,
  simp only [category.id_comp, biproduct.ι_desc_assoc],
  erw biproduct.ι_matrix_assoc, -- Not sure why this doesn't fire via `simp`.
  simp,
end).

/--
`Mat_.lift F` is the unique additive functor `L : Mat_ C ⥤ D` such that `F ≅ embedding C ⋙ L`.
-/
def lift_unique (F : C ⥤ D) [functor.additive F] (L : Mat_ C ⥤ D) [functor.additive L]
  (α : embedding C ⋙ L ≅ F) :
  L ≅ lift F :=
nat_iso.of_components
  (λ M, (additive_obj_iso_biproduct L M) ≪≫
    (biproduct.map_iso (λ i, α.app (M.X i))) ≪≫
    (biproduct.map_iso (λ i, (embedding_lift_iso F).symm.app (M.X i))) ≪≫
    (additive_obj_iso_biproduct (lift F) M).symm)
(λ M N f, begin
  dsimp only [iso.trans_hom, iso.symm_hom, biproduct.map_iso_hom],
  simp only [additive_obj_iso_biproduct_naturality_assoc],
  simp only [biproduct.matrix_map_assoc, category.assoc],
  simp only [additive_obj_iso_biproduct_naturality'],
  simp only [biproduct.map_matrix_assoc, category.assoc],
  congr,
  ext j k ⟨⟩,
  dsimp, simp,
  exact α.hom.naturality (f j k),
end).

-- TODO is there some uniqueness statement for the natural isomorphism in `lift_unique`?

/-- Two additive functors `Mat_ C ⥤ D` are naturally isomorphic if
their precompositions with `embedding C` are naturally isomorphic as functors `C ⥤ D`. -/
@[ext]
def ext {F G : Mat_ C ⥤ D} [functor.additive F] [functor.additive G]
  (α : embedding C ⋙ F ≅ embedding C ⋙ G) : F ≅ G :=
(lift_unique (embedding C ⋙ G) _ α) ≪≫ (lift_unique _ _ (iso.refl _)).symm

/--
Natural isomorphism needed in the construction of `equivalence_self_of_has_finite_biproducts`.
-/
def equivalence_self_of_has_finite_biproducts_aux [has_finite_biproducts C] :
  embedding C ⋙ 𝟭 (Mat_ C) ≅ embedding C ⋙ lift (𝟭 C) ⋙ embedding C :=
functor.right_unitor _ ≪≫
  (functor.left_unitor _).symm ≪≫
  (iso_whisker_right (embedding_lift_iso _).symm _) ≪≫
  functor.associator _ _ _

/--
A preadditive category that already has finite biproducts is equivalent to its additive envelope.

Note that we only prove this for a large category;
otherwise there are universe issues that I haven't attempted to sort out.
-/
def equivalence_self_of_has_finite_biproducts
  (C : Type (u₁+1)) [large_category C] [preadditive C] [has_finite_biproducts C] :
  Mat_ C ≌ C :=
equivalence.mk -- I suspect this is already an adjoint equivalence, but it seems painful to verify.
  (lift (𝟭 C))
  (embedding C)
  (ext equivalence_self_of_has_finite_biproducts_aux)
  (embedding_lift_iso (𝟭 C))

@[simp] lemma equivalence_self_of_has_finite_biproducts_functor
  {C : Type (u₁+1)} [large_category C] [preadditive C] [has_finite_biproducts C] :
  (equivalence_self_of_has_finite_biproducts C).functor = lift (𝟭 C) :=
rfl

@[simp] lemma equivalence_self_of_has_finite_biproducts_inverse
  {C : Type (u₁+1)} [large_category C] [preadditive C] [has_finite_biproducts C] :
  (equivalence_self_of_has_finite_biproducts C).inverse = embedding C :=
rfl

end Mat_

universe u

/-- A type synonym for `Fintype`, which we will equip with a category structure
where the morphisms are matrices with components in `R`. -/
@[nolint unused_arguments, derive inhabited]
def Mat (R : Type u) := Fintype.{u}

instance (R : Type u) : has_coe_to_sort (Mat R) (Type u) := bundled.has_coe_to_sort

open_locale classical matrix

instance (R : Type u) [semiring R] : category (Mat R) :=
{ hom := λ X Y, matrix X Y R,
  id := λ X, 1,
  comp := λ X Y Z f g, f ⬝ g,
  assoc' := by { intros, simp [matrix.mul_assoc], }, }

namespace Mat

section
variables (R : Type u) [semiring R]

lemma id_def (M : Mat R) :
  𝟙 M = λ i j, if h : i = j then 1 else 0 :=
rfl

lemma id_apply (M : Mat R) (i j : M) :
  (𝟙 M : matrix M M R) i j = if h : i = j then 1 else 0 :=
rfl

@[simp] lemma id_apply_self (M : Mat R) (i : M) :
  (𝟙 M : matrix M M R) i i = 1 :=
by simp [id_apply]

@[simp] lemma id_apply_of_ne (M : Mat R) (i j : M) (h : i ≠ j) :
  (𝟙 M : matrix M M R) i j = 0 :=
by simp [id_apply, h]

lemma comp_def {M N K : Mat R} (f : M ⟶ N) (g : N ⟶ K) :
  (f ≫ g) = λ i k, ∑ j : N, f i j * g j k := rfl

@[simp] lemma comp_apply {M N K : Mat R} (f : M ⟶ N) (g : N ⟶ K) (i k) :
  (f ≫ g) i k = ∑ j : N, f i j * g j k := rfl

instance (M N : Mat R) : inhabited (M ⟶ N) := ⟨λ (i : M) (j : N), (0 : R)⟩

end

variables (R : Type) [ring R]

open opposite

/-- Auxiliary definition for `category_theory.Mat.equivalence_single_obj`. -/
@[simps]
def equivalence_single_obj_inverse : Mat_ (single_obj Rᵐᵒᵖ) ⥤ Mat R :=
{ obj := λ X, Fintype.of X.ι,
  map := λ X Y f i j, mul_opposite.unop (f i j),
  map_id' := λ X, by { ext i j, simp [id_def, Mat_.id_def], split_ifs; refl, }, }

instance : faithful (equivalence_single_obj_inverse R) :=
{ map_injective' := λ X Y f g w, begin
    ext i j,
    apply_fun mul_opposite.unop using mul_opposite.unop_injective,
    exact (congr_fun (congr_fun w i) j),
  end }

instance : full (equivalence_single_obj_inverse R) :=
{ preimage := λ X Y f i j, mul_opposite.op (f i j), }

instance : ess_surj (equivalence_single_obj_inverse R) :=
{ mem_ess_image := λ X,
  ⟨{ ι := X, X := λ _, punit.star }, ⟨eq_to_iso (by { dsimp, cases X, congr, })⟩⟩, }

/-- The categorical equivalence between the category of matrices over a ring,
and the category of matrices over that ring considered as a single-object category. -/
def equivalence_single_obj : Mat R ≌ Mat_ (single_obj Rᵐᵒᵖ) :=
begin
  haveI := equivalence.of_fully_faithfully_ess_surj (equivalence_single_obj_inverse R),
  exact (equivalence_single_obj_inverse R).as_equivalence.symm,
end

instance : preadditive (Mat R) :=
{ add_comp' := by { intros, ext, simp [add_mul, finset.sum_add_distrib], },
  comp_add' := by { intros, ext, simp [mul_add, finset.sum_add_distrib], }, }

-- TODO show `Mat R` has biproducts, and that `biprod.map` "is" forming a block diagonal matrix.

end Mat

end category_theory


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import algebraic_topology.dold_kan.functor_n
import algebraic_topology.dold_kan.decomposition
import category_theory.idempotents.homological_complex
import category_theory.idempotents.karoubi_karoubi

/-!

# N₁ and N₂ reflects isomorphisms

In this file, it is shown that the functors
`N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)` and
`N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ))`
reflect isomorphisms for any preadditive category `C`.

-/

open category_theory
open category_theory.category
open category_theory.idempotents
open opposite
open_locale simplicial

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C]

open morph_components

instance : reflects_isomorphisms (N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)) :=
⟨λ X Y f, begin
  introI,
  /- restating the result in a way that allows induction on the degree n -/
  suffices : ∀ (n : ℕ), is_iso (f.app (op [n])),
  { haveI : ∀ (Δ : simplex_categoryᵒᵖ), is_iso (f.app Δ) := λ Δ, this Δ.unop.len,
    apply nat_iso.is_iso_of_is_iso_app, },
  /- restating the assumption in a more practical form -/
  have h₁ := homological_complex.congr_hom (karoubi.hom_ext.mp (is_iso.hom_inv_id (N₁.map f))),
  have h₂ := homological_complex.congr_hom (karoubi.hom_ext.mp (is_iso.inv_hom_id (N₁.map f))),
  have h₃ := λ n, karoubi.homological_complex.p_comm_f_assoc (inv (N₁.map f)) (n) (f.app (op [n])),
  simp only [N₁_map_f, karoubi.comp_f, homological_complex.comp_f,
    alternating_face_map_complex.map_f, N₁_obj_p, karoubi.id_eq, assoc] at h₁ h₂ h₃,
  /- we have to construct an inverse to f in degree n, by induction on n -/
  intro n,
  induction n with n hn,
  /- degree 0 -/
  { use (inv (N₁.map f)).f.f 0,
    have h₁₀ := h₁ 0,
    have h₂₀ := h₂ 0,
    dsimp at h₁₀ h₂₀,
    simp only [id_comp, comp_id] at h₁₀ h₂₀,
    tauto, },
  /- induction step -/
  { haveI := hn,
    use φ
      { a := P_infty.f (n+1) ≫ (inv (N₁.map f)).f.f (n+1),
        b := λ i, inv (f.app (op [n])) ≫ X.σ i, },
    simp only [morph_components.id, ← id_φ, ← pre_comp_φ, pre_comp, ← post_comp_φ,
      post_comp, P_infty_f_naturality_assoc, is_iso.hom_inv_id_assoc, assoc,
      is_iso.inv_hom_id_assoc, simplicial_object.σ_naturality, h₁, h₂, h₃],
    tauto, },
end⟩

lemma compatibility_N₂_N₁_karoubi :
  N₂ ⋙ (karoubi_chain_complex_equivalence C ℕ).functor =
  karoubi_functor_category_embedding simplex_categoryᵒᵖ C ⋙ N₁ ⋙
  (karoubi_chain_complex_equivalence (karoubi C) ℕ).functor ⋙
  functor.map_homological_complex (karoubi_karoubi.equivalence C).inverse _ :=
begin
  refine category_theory.functor.ext (λ P, _) (λ P Q f, _),
  { refine homological_complex.ext _ _,
    { ext n,
      { dsimp,
        simp only [karoubi_P_infty_f, comp_id, P_infty_f_naturality, id_comp], },
      { refl, }, },
    { rintros _ n (rfl : n+1 = _),
      ext,
      have h := (alternating_face_map_complex.map P.p).comm (n+1) n,
      dsimp [N₂, karoubi_chain_complex_equivalence, karoubi_karoubi.inverse,
        karoubi_homological_complex_equivalence.functor.obj] at ⊢ h,
      simp only [karoubi.comp_f, assoc, karoubi.eq_to_hom_f, eq_to_hom_refl, id_comp, comp_id,
        karoubi_alternating_face_map_complex_d, karoubi_P_infty_f,
        ← homological_complex.hom.comm_assoc, ← h, app_idem_assoc], }, },
  { ext n,
    dsimp [karoubi_karoubi.inverse, karoubi_functor_category_embedding,
      karoubi_functor_category_embedding.map],
    simp only [karoubi.comp_f, karoubi_P_infty_f, homological_complex.eq_to_hom_f,
      karoubi.eq_to_hom_f, assoc, comp_id, P_infty_f_naturality, app_p_comp,
      karoubi_chain_complex_equivalence_functor_obj_X_p, N₂_obj_p_f, eq_to_hom_refl,
      P_infty_f_naturality_assoc, app_comp_p, P_infty_f_idem_assoc], },
end

/-- We deduce that `N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ))`
reflects isomorphisms from the fact that
`N₁ : simplicial_object (karoubi C) ⥤ karoubi (chain_complex (karoubi C) ℕ)` does. -/
instance : reflects_isomorphisms
  (N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)) := ⟨λ X Y f,
begin
  introI,
  -- The following functor `F` reflects isomorphism because it is
  -- a composition of four functors which reflects isomorphisms.
  -- Then, it suffices to show that `F.map f` is an isomorphism.
  let F := karoubi_functor_category_embedding simplex_categoryᵒᵖ C ⋙ N₁ ⋙
    (karoubi_chain_complex_equivalence (karoubi C) ℕ).functor ⋙
    functor.map_homological_complex (karoubi_karoubi.equivalence C).inverse
      (complex_shape.down ℕ),
  haveI : is_iso (F.map f),
  { dsimp only [F],
    rw [← compatibility_N₂_N₁_karoubi, functor.comp_map],
    apply functor.map_is_iso, },
  exact is_iso_of_reflects_iso f F,
end⟩

end dold_kan

end algebraic_topology


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.endomorphism
import Mathlib.algebra.group_power.default
import Mathlib.PostPort

universes u v v₁ u₁

namespace Mathlib

/-!
# Conjugate morphisms by isomorphisms

An isomorphism `α : X ≅ Y` defines
- a monoid isomorphism `conj : End X ≃* End Y` by `α.conj f = α.inv ≫ f ≫ α.hom`;
- a group isomorphism `conj_Aut : Aut X ≃* Aut Y` by `α.conj_Aut f = α.symm ≪≫ f ≪≫ α`.

For completeness, we also define `hom_congr : (X ≅ X₁) → (Y ≅ Y₁) → (X ⟶ Y) ≃ (X₁ ⟶ Y₁)`, cf. `equiv.arrow_congr`.
-/

namespace category_theory

namespace iso

/-- If `X` is isomorphic to `X₁` and `Y` is isomorphic to `Y₁`, then
there is a natural bijection between `X ⟶ Y` and `X₁ ⟶ Y₁`. See also `equiv.arrow_congr`. -/
def hom_congr {C : Type u} [category C] {X : C} {Y : C} {X₁ : C} {Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) : (X ⟶ Y) ≃ (X₁ ⟶ Y₁) :=
  equiv.mk (fun (f : X ⟶ Y) => inv α ≫ f ≫ hom β) (fun (f : X₁ ⟶ Y₁) => hom α ≫ f ≫ inv β) sorry sorry

@[simp] theorem hom_congr_apply {C : Type u} [category C] {X : C} {Y : C} {X₁ : C} {Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (f : X ⟶ Y) : coe_fn (hom_congr α β) f = inv α ≫ f ≫ hom β :=
  rfl

theorem hom_congr_comp {C : Type u} [category C] {X : C} {Y : C} {Z : C} {X₁ : C} {Y₁ : C} {Z₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (γ : Z ≅ Z₁) (f : X ⟶ Y) (g : Y ⟶ Z) : coe_fn (hom_congr α γ) (f ≫ g) = coe_fn (hom_congr α β) f ≫ coe_fn (hom_congr β γ) g := sorry

@[simp] theorem hom_congr_refl {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) : coe_fn (hom_congr (refl X) (refl Y)) f = f := sorry

@[simp] theorem hom_congr_trans {C : Type u} [category C] {X₁ : C} {Y₁ : C} {X₂ : C} {Y₂ : C} {X₃ : C} {Y₃ : C} (α₁ : X₁ ≅ X₂) (β₁ : Y₁ ≅ Y₂) (α₂ : X₂ ≅ X₃) (β₂ : Y₂ ≅ Y₃) (f : X₁ ⟶ Y₁) : coe_fn (hom_congr (α₁ ≪≫ α₂) (β₁ ≪≫ β₂)) f = coe_fn (equiv.trans (hom_congr α₁ β₁) (hom_congr α₂ β₂)) f := sorry

@[simp] theorem hom_congr_symm {C : Type u} [category C] {X₁ : C} {Y₁ : C} {X₂ : C} {Y₂ : C} (α : X₁ ≅ X₂) (β : Y₁ ≅ Y₂) : equiv.symm (hom_congr α β) = hom_congr (symm α) (symm β) :=
  rfl

/-- An isomorphism between two objects defines a monoid isomorphism between their
monoid of endomorphisms. -/
def conj {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : End X ≃* End Y :=
  mul_equiv.mk (equiv.to_fun (hom_congr α α)) (equiv.inv_fun (hom_congr α α)) sorry sorry sorry

theorem conj_apply {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : End X) : coe_fn (conj α) f = inv α ≫ f ≫ hom α :=
  rfl

@[simp] theorem conj_comp {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : End X) (g : End X) : coe_fn (conj α) (f ≫ g) = coe_fn (conj α) f ≫ coe_fn (conj α) g :=
  mul_equiv.map_mul (conj α) g f

@[simp] theorem conj_id {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : coe_fn (conj α) 𝟙 = 𝟙 :=
  mul_equiv.map_one (conj α)

@[simp] theorem refl_conj {C : Type u} [category C] {X : C} (f : End X) : coe_fn (conj (refl X)) f = f := sorry

@[simp] theorem trans_conj {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) {Z : C} (β : Y ≅ Z) (f : End X) : coe_fn (conj (α ≪≫ β)) f = coe_fn (conj β) (coe_fn (conj α) f) :=
  hom_congr_trans α α β β f

@[simp] theorem symm_self_conj {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : End X) : coe_fn (conj (symm α)) (coe_fn (conj α) f) = f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn (conj (symm α)) (coe_fn (conj α) f) = f)) (Eq.symm (trans_conj α (symm α) f))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn (conj (α ≪≫ symm α)) f = f)) (self_symm_id α)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn (conj (refl X)) f = f)) (refl_conj f))) (Eq.refl f)))

@[simp] theorem self_symm_conj {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : End Y) : coe_fn (conj α) (coe_fn (conj (symm α)) f) = f :=
  symm_self_conj (symm α) f

@[simp] theorem conj_pow {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : End X) (n : ℕ) : coe_fn (conj α) (f ^ n) = coe_fn (conj α) f ^ n :=
  monoid_hom.map_pow (mul_equiv.to_monoid_hom (conj α)) f n

/-- `conj` defines a group isomorphisms between groups of automorphisms -/
def conj_Aut {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) : Aut X ≃* Aut Y :=
  mul_equiv.trans (mul_equiv.symm (Aut.units_End_equiv_Aut X))
    (mul_equiv.trans (units.map_equiv (conj α)) (Aut.units_End_equiv_Aut Y))

theorem conj_Aut_apply {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : Aut X) : coe_fn (conj_Aut α) f = symm α ≪≫ f ≪≫ α := sorry

@[simp] theorem conj_Aut_hom {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : Aut X) : hom (coe_fn (conj_Aut α) f) = coe_fn (conj α) (hom f) :=
  rfl

@[simp] theorem trans_conj_Aut {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) {Z : C} (β : Y ≅ Z) (f : Aut X) : coe_fn (conj_Aut (α ≪≫ β)) f = coe_fn (conj_Aut β) (coe_fn (conj_Aut α) f) := sorry

@[simp] theorem conj_Aut_mul {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : Aut X) (g : Aut X) : coe_fn (conj_Aut α) (f * g) = coe_fn (conj_Aut α) f * coe_fn (conj_Aut α) g :=
  mul_equiv.map_mul (conj_Aut α) f g

@[simp] theorem conj_Aut_trans {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : Aut X) (g : Aut X) : coe_fn (conj_Aut α) (f ≪≫ g) = coe_fn (conj_Aut α) f ≪≫ coe_fn (conj_Aut α) g :=
  conj_Aut_mul α g f

@[simp] theorem conj_Aut_pow {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : Aut X) (n : ℕ) : coe_fn (conj_Aut α) (f ^ n) = coe_fn (conj_Aut α) f ^ n :=
  monoid_hom.map_pow (mul_equiv.to_monoid_hom (conj_Aut α)) f n

@[simp] theorem conj_Aut_gpow {C : Type u} [category C] {X : C} {Y : C} (α : X ≅ Y) (f : Aut X) (n : ℤ) : coe_fn (conj_Aut α) (f ^ n) = coe_fn (conj_Aut α) f ^ n :=
  monoid_hom.map_gpow (mul_equiv.to_monoid_hom (conj_Aut α)) f n

end iso

namespace functor

theorem map_hom_congr {C : Type u} [category C] {D : Type u₁} [category D] (F : C ⥤ D) {X : C} {Y : C} {X₁ : C} {Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (f : X ⟶ Y) : map F (coe_fn (iso.hom_congr α β) f) = coe_fn (iso.hom_congr (map_iso F α) (map_iso F β)) (map F f) := sorry

theorem map_conj {C : Type u} [category C] {D : Type u₁} [category D] (F : C ⥤ D) {X : C} {Y : C} (α : X ≅ Y) (f : End X) : map F (coe_fn (iso.conj α) f) = coe_fn (iso.conj (map_iso F α)) (map F f) :=
  map_hom_congr F α α f

theorem map_conj_Aut {C : Type u} [category C] {D : Type u₁} [category D] (F : C ⥤ D) {X : C} {Y : C} (α : X ≅ Y) (f : Aut X) : map_iso F (coe_fn (iso.conj_Aut α) f) = coe_fn (iso.conj_Aut (map_iso F α)) (map_iso F f) := sorry


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.preserves.basic
import Mathlib.category_theory.limits.shapes.equalizers
import Mathlib.category_theory.limits.shapes.strong_epi
import Mathlib.category_theory.limits.shapes.pullbacks
import Mathlib.PostPort

universes v₁ u₁ l

namespace Mathlib

/-!
# Definitions and basic properties of regular monomorphisms and epimorphisms.

A regular monomorphism is a morphism that is the equalizer of some parallel pair.

We give the constructions
* `split_mono → regular_mono` and
* `regular_mono → mono`
as well as the dual constructions for regular epimorphisms. Additionally, we give the
construction
* `regular_epi ⟶ strong_epi`.

-/

namespace category_theory

/-- A regular monomorphism is a morphism which is the equalizer of some parallel pair. -/
class regular_mono {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y) where
  Z : C
  left : Y ⟶ Z
  right : Y ⟶ Z
  w : f ≫ left = f ≫ right
  is_limit : limits.is_limit (limits.fork.of_ι f w)

theorem regular_mono.w_assoc {C : Type u₁} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    [c : regular_mono f] {X' : C} (f' : regular_mono.Z f ⟶ X') :
    f ≫ regular_mono.left ≫ f' = f ≫ regular_mono.right ≫ f' :=
  sorry

/-- Every regular monomorphism is a monomorphism. -/
protected instance regular_mono.mono {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    [regular_mono f] : mono f :=
  limits.mono_of_is_limit_parallel_pair regular_mono.is_limit

protected instance equalizer_regular {C : Type u₁} [category C] {X : C} {Y : C} (g : X ⟶ Y)
    (h : X ⟶ Y) [limits.has_limit (limits.parallel_pair g h)] :
    regular_mono (limits.equalizer.ι g h) :=
  regular_mono.mk Y g h (limits.equalizer.condition g h)
    (limits.fork.is_limit.mk
      (limits.fork.of_ι (limits.equalizer.ι g h) (limits.equalizer.condition g h))
      (fun (s : limits.fork g h) => limits.limit.lift (limits.parallel_pair g h) s) sorry sorry)

/-- Every split monomorphism is a regular monomorphism. -/
protected instance regular_mono.of_split_mono {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    [split_mono f] : regular_mono f :=
  regular_mono.mk Y 𝟙 (retraction f ≫ f) (limits.cone_of_split_mono._proof_1 f)
    (limits.split_mono_equalizes f)

/-- If `f` is a regular mono, then any map `k : W ⟶ Y` equalizing `regular_mono.left` and
    `regular_mono.right` induces a morphism `l : W ⟶ X` such that `l ≫ f = k`. -/
def regular_mono.lift' {C : Type u₁} [category C] {X : C} {Y : C} {W : C} (f : X ⟶ Y)
    [regular_mono f] (k : W ⟶ Y) (h : k ≫ regular_mono.left = k ≫ regular_mono.right) :
    Subtype fun (l : W ⟶ X) => l ≫ f = k :=
  limits.fork.is_limit.lift' regular_mono.is_limit k h

/--
The second leg of a pullback cone is a regular monomorphism if the right component is too.

See also `pullback.snd_of_mono` for the basic monomorphism version, and
`regular_of_is_pullback_fst_of_regular` for the flipped version.
-/
def regular_of_is_pullback_snd_of_regular {C : Type u₁} [category C] {P : C} {Q : C} {R : C} {S : C}
    {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S} {k : R ⟶ S} [hr : regular_mono h] (comm : f ≫ h = g ≫ k)
    (t : limits.is_limit (limits.pullback_cone.mk f g comm)) : regular_mono g :=
  sorry

/--
The first leg of a pullback cone is a regular monomorphism if the left component is too.

See also `pullback.fst_of_mono` for the basic monomorphism version, and
`regular_of_is_pullback_snd_of_regular` for the flipped version.
-/
def regular_of_is_pullback_fst_of_regular {C : Type u₁} [category C] {P : C} {Q : C} {R : C} {S : C}
    {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S} {k : R ⟶ S} [hr : regular_mono k] (comm : f ≫ h = g ≫ k)
    (t : limits.is_limit (limits.pullback_cone.mk f g comm)) : regular_mono f :=
  regular_of_is_pullback_snd_of_regular sorry (limits.pullback_cone.flip_is_limit t)

/-- A regular monomorphism is an isomorphism if it is an epimorphism. -/
def is_iso_of_regular_mono_of_epi {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    [regular_mono f] [e : epi f] : is_iso f :=
  limits.is_iso_limit_cone_parallel_pair_of_epi regular_mono.is_limit

/-- A regular epimorphism is a morphism which is the coequalizer of some parallel pair. -/
class regular_epi {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y) where
  W : C
  left : W ⟶ X
  right : W ⟶ X
  w : left ≫ f = right ≫ f
  is_colimit : limits.is_colimit (limits.cofork.of_π f w)

theorem regular_epi.w_assoc {C : Type u₁} [category C] {X : C} {Y : C} {f : X ⟶ Y}
    [c : regular_epi f] {X' : C} (f' : Y ⟶ X') :
    regular_epi.left ≫ f ≫ f' = regular_epi.right ≫ f ≫ f' :=
  sorry

/-- Every regular epimorphism is an epimorphism. -/
protected instance regular_epi.epi {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    [regular_epi f] : epi f :=
  limits.epi_of_is_colimit_parallel_pair regular_epi.is_colimit

protected instance coequalizer_regular {C : Type u₁} [category C] {X : C} {Y : C} (g : X ⟶ Y)
    (h : X ⟶ Y) [limits.has_colimit (limits.parallel_pair g h)] :
    regular_epi (limits.coequalizer.π g h) :=
  regular_epi.mk X g h (limits.coequalizer.condition g h)
    (limits.cofork.is_colimit.mk
      (limits.cofork.of_π (limits.coequalizer.π g h) (limits.coequalizer.condition g h))
      (fun (s : limits.cofork g h) => limits.colimit.desc (limits.parallel_pair g h) s) sorry sorry)

/-- Every split epimorphism is a regular epimorphism. -/
protected instance regular_epi.of_split_epi {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    [split_epi f] : regular_epi f :=
  regular_epi.mk X 𝟙 (f ≫ section_ f) (limits.cocone_of_split_epi._proof_1 f)
    (limits.split_epi_coequalizes f)

/-- If `f` is a regular epi, then every morphism `k : X ⟶ W` coequalizing `regular_epi.left` and
    `regular_epi.right` induces `l : Y ⟶ W` such that `f ≫ l = k`. -/
def regular_epi.desc' {C : Type u₁} [category C] {X : C} {Y : C} {W : C} (f : X ⟶ Y) [regular_epi f]
    (k : X ⟶ W) (h : regular_epi.left ≫ k = regular_epi.right ≫ k) :
    Subtype fun (l : Y ⟶ W) => f ≫ l = k :=
  limits.cofork.is_colimit.desc' regular_epi.is_colimit k h

/--
The second leg of a pushout cocone is a regular epimorphism if the right component is too.

See also `pushout.snd_of_epi` for the basic epimorphism version, and
`regular_of_is_pushout_fst_of_regular` for the flipped version.
-/
def regular_of_is_pushout_snd_of_regular {C : Type u₁} [category C] {P : C} {Q : C} {R : C} {S : C}
    {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S} {k : R ⟶ S} [gr : regular_epi g] (comm : f ≫ h = g ≫ k)
    (t : limits.is_colimit (limits.pushout_cocone.mk h k comm)) : regular_epi h :=
  sorry

/--
The first leg of a pushout cocone is a regular epimorphism if the left component is too.

See also `pushout.fst_of_epi` for the basic epimorphism version, and
`regular_of_is_pushout_snd_of_regular` for the flipped version.
-/
def regular_of_is_pushout_fst_of_regular {C : Type u₁} [category C] {P : C} {Q : C} {R : C} {S : C}
    {f : P ⟶ Q} {g : P ⟶ R} {h : Q ⟶ S} {k : R ⟶ S} [fr : regular_epi f] (comm : f ≫ h = g ≫ k)
    (t : limits.is_colimit (limits.pushout_cocone.mk h k comm)) : regular_epi k :=
  regular_of_is_pushout_snd_of_regular sorry (limits.pushout_cocone.flip_is_colimit t)

/-- A regular epimorphism is an isomorphism if it is a monomorphism. -/
def is_iso_of_regular_epi_of_mono {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    [regular_epi f] [m : mono f] : is_iso f :=
  limits.is_iso_limit_cocone_parallel_pair_of_epi regular_epi.is_colimit

protected instance strong_epi_of_regular_epi {C : Type u₁} [category C] {X : C} {Y : C} (f : X ⟶ Y)
    [regular_epi f] : strong_epi f :=
  sorry

end Mathlib


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import category_theory.concrete_category.basic

/-!
# The category of pointed types

This defines `Pointed`, the category of pointed types.

## TODO

* Monoidal structure
* Upgrade `Type_to_Pointed` to an equivalence
-/

open category_theory

universes u
variables {α β : Type*}

/-- The category of pointed types. -/
structure Pointed : Type.{u + 1} :=
(X : Type.{u})
(point : X)

namespace Pointed

instance : has_coe_to_sort Pointed Type* := ⟨X⟩

attribute [protected] Pointed.X

/-- Turns a point into a pointed type. -/
def of {X : Type*} (point : X) : Pointed := ⟨X, point⟩

@[simp] lemma coe_of {X : Type*} (point : X) : ↥(of point) = X := rfl

alias of ← prod.Pointed

instance : inhabited Pointed := ⟨of ((), ())⟩

/-- Morphisms in `Pointed`. -/
@[ext] protected structure hom (X Y : Pointed.{u}) : Type u :=
(to_fun : X → Y)
(map_point : to_fun X.point = Y.point)

namespace hom

/-- The identity morphism of `X : Pointed`. -/
@[simps] def id (X : Pointed) : hom X X := ⟨id, rfl⟩

instance (X : Pointed) : inhabited (hom X X) := ⟨id X⟩

/-- Composition of morphisms of `Pointed`. -/
@[simps] def comp {X Y Z : Pointed.{u}} (f : hom X Y) (g : hom Y Z) : hom X Z :=
⟨g.to_fun ∘ f.to_fun, by rw [function.comp_apply, f.map_point, g.map_point]⟩

end hom

instance large_category : large_category Pointed :=
{ hom := hom,
  id := hom.id,
  comp := @hom.comp,
  id_comp' := λ _ _ _, hom.ext _ _ rfl,
  comp_id' := λ _ _ _, hom.ext _ _ rfl,
  assoc' := λ _ _ _ _ _ _ _, hom.ext _ _ rfl }

instance concrete_category : concrete_category Pointed :=
{ forget := { obj := Pointed.X, map := @hom.to_fun },
  forget_faithful := ⟨@hom.ext⟩ }

/-- Constructs a isomorphism between pointed types from an equivalence that preserves the point
between them. -/
@[simps] def iso.mk {α β : Pointed} (e : α ≃ β) (he : e α.point = β.point) : α ≅ β :=
{ hom := ⟨e, he⟩,
  inv := ⟨e.symm, e.symm_apply_eq.2 he.symm⟩,
  hom_inv_id' := Pointed.hom.ext _ _ e.symm_comp_self,
  inv_hom_id' := Pointed.hom.ext _ _ e.self_comp_symm }

end Pointed

/-- `option` as a functor from types to pointed types. This is the free functor. -/
@[simps] def Type_to_Pointed : Type.{u} ⥤ Pointed.{u} :=
{ obj := λ X, ⟨option X, none⟩,
  map := λ X Y f, ⟨option.map f, rfl⟩,
  map_id' := λ X, Pointed.hom.ext _ _ option.map_id,
  map_comp' := λ X Y Z f g, Pointed.hom.ext _ _ (option.map_comp_map _ _).symm }

/-- `Type_to_Pointed` is the free functor. -/
def Type_to_Pointed_forget_adjunction : Type_to_Pointed ⊣ forget Pointed :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y, { to_fun := λ f, f.to_fun ∘ option.some,
                        inv_fun := λ f, ⟨λ o, o.elim Y.point f, rfl⟩,
                        left_inv := λ f, by { ext, cases x, exact f.map_point.symm, refl },
                        right_inv := λ f, funext $ λ _, rfl },
  hom_equiv_naturality_left_symm' := λ X' X Y f g, by { ext, cases x; refl }, }


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Extends the theory on functors, applicatives and monads.
-/

universes u v
variables {α β γ : Type u}

notation a ` $< `:1 f:1 := f a

section functor
variables {f : Type u → Type v} [functor f] [is_lawful_functor f]

run_cmd mk_simp_attr `functor_norm

@[functor_norm] protected theorem map_map (m : α → β) (g : β → γ) (x : f α) :
  g <$> (m <$> x) = (g ∘ m) <$> x :=
(comp_map _ _ _).symm

@[simp] theorem id_map' (x : f α) : (λa, a) <$> x = x := id_map _

end functor

section applicative
variables {F : Type u → Type v} [applicative F]

def mzip_with
  {α₁ α₂ φ : Type u}
  (f : α₁ → α₂ → F φ) :
  Π (ma₁ : list α₁) (ma₂: list α₂), F (list φ)
| (x :: xs) (y :: ys) := (::) <$> f x y <*> mzip_with xs ys
| _ _ := pure []

def mzip_with'  (f : α → β → F γ) : list α → list β → F punit
| (x :: xs) (y :: ys) := f x y *> mzip_with' xs ys
| [] _ := pure punit.star
| _ [] := pure punit.star

protected def option.traverse {α β : Type*} (f : α → F β) : option α → F (option β)
| none := pure none
| (some x) := some <$> f x

protected def list.traverse {α β : Type*} (f : α → F β) : list α → F (list β)
| [] := pure []
| (x :: xs) := list.cons <$> f x <*> list.traverse xs

variables [is_lawful_applicative F]

attribute [functor_norm] seq_assoc pure_seq_eq_map

@[simp] theorem pure_id'_seq (x : F α) : pure (λx, x) <*> x = x :=
pure_id_seq x

variables  [is_lawful_applicative F]

attribute [functor_norm] seq_assoc pure_seq_eq_map

@[functor_norm] theorem seq_map_assoc (x : F (α → β)) (f : γ → α) (y : F γ) :
  (x <*> (f <$> y)) = (λ(m:α→β), m ∘ f) <$> x <*> y :=
begin
  simp [(pure_seq_eq_map _ _).symm],
  simp [seq_assoc, (comp_map _ _ _).symm, (∘)],
  simp [pure_seq_eq_map]
end

@[functor_norm] theorem map_seq (f : β → γ) (x : F (α → β)) (y : F α) :
  (f <$> (x <*> y)) = ((∘) f) <$> x <*> y :=
by simp [(pure_seq_eq_map _ _).symm]; simp [seq_assoc]

end applicative

-- TODO: setup `functor_norm` for `monad` laws
section monad
variables {m : Type u → Type v} [monad m] [is_lawful_monad m]

open list

def list.mpartition {f : Type → Type} [monad f] {α : Type} (p : α → f bool) :
  list α → f (list α × list α)
| [] := pure ([],[])
| (x :: xs) :=
mcond (p x) (prod.map (cons x) id <$> list.mpartition xs)
            (prod.map id (cons x) <$> list.mpartition xs)

lemma map_bind (x : m α) {g : α → m β} {f : β → γ} : f <$> (x >>= g) = (x >>= λa, f <$> g a) :=
by rw [← bind_pure_comp_eq_map,bind_assoc]; simp [bind_pure_comp_eq_map]

lemma seq_bind_eq (x : m α) {g : β → m γ} {f : α → β} : (f <$> x) >>= g = (x >>= g ∘ f) :=
show bind (f <$> x) g = bind x (g ∘ f),
by rw [← bind_pure_comp_eq_map, bind_assoc]; simp [pure_bind]

lemma seq_eq_bind_map {x : m α} {f : m (α → β)} : f <*> x = (f >>= (<$> x)) :=
(bind_map_eq_seq m f x).symm

end monad

section alternative
variables {F : Type → Type v} [alternative F]

def succeeds {α} (x : F α) : F bool := (x $> tt) <|> pure ff

def mtry {α} (x : F α) : F unit := (x $> ()) <|> pure ()

@[simp] theorem guard_true {h : decidable true} :
  @guard F _ true h = pure () := by simp [guard]

@[simp] theorem guard_false {h : decidable false} :
  @guard F _ false h = failure := by simp [guard]

end alternative

class is_comm_applicative (m : Type* → Type*) [applicative m] extends is_lawful_applicative m : Prop :=
(commutative_prod : ∀{α β} (a : m α) (b : m β), prod.mk <$> a <*> b = (λb a, (a, b)) <$> b <*> a)

lemma is_comm_applicative.commutative_map
  {m : Type* → Type*} [applicative m] [is_comm_applicative m]
  {α β γ} (a : m α) (b : m β) {f : α → β → γ} :
  f <$> a <*> b = flip f <$> b <*> a :=
calc f <$> a <*> b = (λp:α×β, f p.1 p.2) <$> (prod.mk <$> a <*> b) :
    by simp [seq_map_assoc, map_seq, seq_assoc, seq_pure, map_map]
  ... = (λb a, f a b) <$> b <*> a :
    by rw [is_comm_applicative.commutative_prod];
        simp [seq_map_assoc, map_seq, seq_assoc, seq_pure, map_map]


import Duper.Simp
import Duper.Selection
import Duper.Util.ProofReconstruction
import Duper.Util.Misc

namespace Duper

open Lean
open Lean.Meta
open RuleM
open Meta
open SimpResult
open Comparison

initialize Lean.registerTraceClass `Rule.boolSimp

/-
  Rules 1 through 15 are from Leo-III. Rules 16 through 22 and 25 through 27 are from "Superposition with
  First-Class Booleans and Inprocessing Clausification." Rules 23, 24, and 28 were made just for duper.
-/
inductive BoolSimpRule
  | rule1 -- s ∨ s ↦ s
  | rule2 -- ¬s ∨ s ↦ True
  | rule2Sym -- s ∨ ¬s ↦ True
  | rule3 -- s ∨ True ↦ True
  | rule3Sym -- True ∨ s ↦ True
  | rule4 -- s ∨ False ↦ s
  | rule4Sym -- False ∨ s ↦ s
  | rule5 -- s = s ↦ True
  | rule6 -- s = True ↦ s
  | rule6Sym -- True = s ↦ s
  | rule7 -- Not False ↦ True
  | rule8 -- s ∧ s ↦ s
  | rule9 -- ¬s ∧ s ↦ False
  | rule9Sym -- s ∧ ¬s ↦ False
  | rule10 -- s ∧ True ↦ s
  | rule10Sym -- True ∧ s ↦ s
  | rule11 -- s ∧ False ↦ False
  | rule11Sym -- False ∧ s ↦ False
  | rule12 -- s ≠ s ↦ False
  | rule13 -- s = False ↦ ¬s
  | rule13Sym -- False = s ↦ ¬s
  | rule14 -- Not True ↦ False
  | rule15 -- ¬¬s ↦ s
  | rule16 -- True → s ↦ s
  | rule17 -- False → s ↦ True
  | rule18 -- s → False ↦ ¬s
  | rule19 -- s → True ↦ True (we generalize this to (∀ _ : α, True) ↦ True)
  | rule20 -- s → ¬s ↦ ¬s
  | rule21 -- ¬s → s ↦ s
  | rule22 -- s → s ↦ True
  | rule23 -- ∀ p : Prop, f(p) ↦ f True ∧ f False
  | rule24 -- ∃ p : Prop, f(p) ↦ f True ∨ f False
  | rule25 -- (s1 → s2 → ... → sn → v) ↦ True if there exists i and j such that si = ¬sj
  | rule26 -- (s1 → s2 → ... → sn → v1 ∨ ... ∨ vm) ↦ True if there exists i and j such that si = vj
  | rule27 -- (s1 ∧ s2 ∧ ... ∧ sn → v1 ∨ ... ∨ vm) ↦ True if there exists i and j such that si = vj
  | rule28 -- s1 ↔ s2 ↦ s1 = s2
deriving Repr

open BoolSimpRule

def BoolSimpRule.format (boolSimpRule : BoolSimpRule) : MessageData :=
  match boolSimpRule with
  | rule1 => m!"rule1"
  | rule2 => m!"rule2"
  | rule2Sym => m!"rule2Sym"
  | rule3 => m!"rule3"
  | rule3Sym => m!"rule3Sym"
  | rule4 => m!"rule4"
  | rule4Sym => m!"rule4Sym"
  | rule5 => m!"rule5"
  | rule6 => m!"rule6"
  | rule6Sym => m!"rule6Sym"
  | rule7 => m!"rule7"
  | rule8 => m!"rule8"
  | rule9 => m!"rule9"
  | rule9Sym => m!"rule9Sym"
  | rule10 => m!"rule10"
  | rule10Sym => m!"rule10Sym"
  | rule11 => m!"rule11"
  | rule11Sym => m!"rule11Sym"
  | rule12 => m!"rule12"
  | rule13 => m!"rule13"
  | rule13Sym => m!"rule13Sym"
  | rule14 => m!"rule14"
  | rule15 => m!"rule15"
  | rule16 => m!"rule16"
  | rule17 => m!"rule17"
  | rule18 => m!"rule18"
  | rule19 => m!"rule19"
  | rule20 => m!"rule20"
  | rule21 => m!"rule21"
  | rule22 => m!"rule22"
  | rule23 => m!"rule23"
  | rule24 => m!"rule24"
  | rule25 => m!"rule25"
  | rule26 => m!"rule26"
  | rule27 => m!"rule27"
  | rule28 => m!"rule28"

instance : ToMessageData BoolSimpRule := ⟨BoolSimpRule.format⟩

theorem rule1Theorem (p : Prop) : (p ∨ p) = p := by simp
theorem rule2Theorem (p : Prop) : (¬p ∨ p) = True := by
  apply @Classical.byCases p
  . intro hp
    apply eq_true
    exact Or.intro_right _ hp
  . intro hnp
    apply eq_true
    exact Or.intro_left _ hnp
theorem rule2SymTheorem (p : Prop) : (p ∨ ¬p) = True := by
  by_cases h : p
  . apply eq_true
    exact Or.intro_left _ h
  . apply eq_true
    exact Or.intro_right _ h
theorem rule3Theorem (p : Prop) : (p ∨ True) = True := by simp
theorem rule3SymTheorem (p : Prop) : (True ∨ p) = True := by simp
theorem rule4Theorem (p : Prop) : (p ∨ False) = p := by simp
theorem rule4SymTheorem (p : Prop) : (False ∨ p) = p := by simp
theorem rule5Theorem (p : α) : (p = p) = True := by simp
theorem rule6Theorem (p : Prop) : (p = True) = p := by simp
theorem rule6SymTheorem (p : Prop) : (True = p) = p := by simp
theorem rule7Theorem : Not False = True := by simp
theorem rule8Theorem (p : Prop) : (p ∧ p) = p := by simp
theorem rule9Theorem (p : Prop) : (¬p ∧ p) = False := by simp
theorem rule9SymTheorem (p : Prop) : (p ∧ ¬p) = False := by simp
theorem rule10Theorem (p : Prop) : (p ∧ True) = p := by simp
theorem rule10SymTheorem (p : Prop) : (True ∧ p) = p := by simp
theorem rule11Theorem (p : Prop) : (p ∧ False) = False := by simp
theorem rule11SymTheorem (p : Prop) : (False ∧ p) = False := by simp
theorem rule12Theorem (p : α) : (p ≠ p) = False := by simp
theorem rule13Theorem (p : Prop) : (p = False) = ¬p := by simp
theorem rule13SymTheorem (p : Prop) : (False = p) = ¬p := by simp
theorem rule14Theorem : Not True = False := by simp
theorem rule15Theorem (p : Prop) : (¬¬p) = p := by rw [Classical.not_not]
theorem rule16Theorem (p : Prop) : (True → p) = p := by simp
theorem rule17Theorem (p : Prop) : (False → p) = True := by simp
theorem rule18Theorem (p : Prop) : (p → False) = ¬p := by rfl
theorem rule19Theorem (α) : (∀ _ : α, True) = True := by simp
theorem rule20Theorem (p : Prop) : (p → ¬p) = ¬p := by simp
theorem rule21Theorem (p : Prop) : (¬p → p) = p := by
  by_cases h : p
  . rw [eq_true h]
    simp
  . rw [eq_false h]
    simp
theorem rule22Theorem (p : Prop) : (p → p) = True := by simp
theorem rule23Theorem (f : Prop → Prop) : (∀ p : Prop, f p) = (f True ∧ f False) := by
  by_cases h : ∀ p : Prop, f p
  . rw [eq_true h]
    apply Eq.symm
    apply eq_true
    constructor
    . exact h True
    . exact h False
  . rw [eq_false h]
    apply Eq.symm
    apply eq_false
    intro h2
    have h3 : (∀ p : Prop, f p) := by
      intro p
      by_cases hp : p
      . rw [eq_true hp]
        exact h2.1
      . rw [eq_false hp]
        exact h2.2
    exact h h3
theorem rule24Theorem (f : Prop → Prop) : (∃ p : Prop, f p) = (f True ∨ f False) := by
  by_cases h : ∃ p : Prop, f p
  . rw [eq_true h]
    apply Eq.symm
    apply eq_true
    cases h with
    | intro p h =>
      cases Classical.propComplete p with
      | inl p_eq_true =>
        rw [p_eq_true] at h
        exact Or.inl h
      | inr p_eq_false =>
        rw [p_eq_false] at h
        exact Or.inr h
  . rw [eq_false h]
    apply Eq.symm
    apply eq_false
    intro h2
    cases h2 with
    | inl f_true =>
      have h2 : ∃ p : Prop, f p := Exists.intro True f_true
      exact h h2
    | inr f_false =>
      have h2 : ∃ p : Prop, f p := Exists.intro False f_false
      exact h h2
theorem rule28Theorem (p1 : Prop) (p2 : Prop) : (p1 ↔ p2) = (p1 = p2) := by simp

partial def mkRule25Theorem (e : Expr) (counter : Nat) (i : Nat) (j : Nat) : MetaM Expr := do
  match e.consumeMData with
  | Expr.forallE _ t b _ =>
    let innerBody ← mkRule25Theorem b (counter + 1) i j
    return .lam Name.anonymous t innerBody default
  | _ =>
    let iIdx := (counter - 1) - i
    let jIdx := (counter - 1) - j
    return mkApp2 (mkConst ``False.elim [levelZero]) e (mkApp (Expr.bvar iIdx) (Expr.bvar jIdx))

/-- Assuming e has the form e1 ∨ e2 ∨ ... ∨ en, returns an array #[e1, e2, ... en].
    Note: If e has the form (e1a ∨ e1b) ∨ e2 ∨ ... en, then the disjunction (e1a ∨ e1b) will
    be considered e1 (and the disjunction e1 will not be broken down further). This decision is made
    to reflect the form of the disjunction assumed by ProofReconstruction.lean's `orIntro` -/
partial def getDisjunctiveGoals (e : Expr) (goals : Array Expr) : Array Expr :=
  match e.consumeMData with
  | Expr.app (Expr.app (Expr.const ``Or _) e1) e2 => getDisjunctiveGoals e2 (goals.push e1)
  | _ => goals.push e

partial def mkRule26Theorem (e : Expr) (counter : Nat) (i : Nat) (j : Nat) : MetaM Expr := do
  match e.consumeMData with
  | Expr.forallE _ t b _ =>
    let innerBody ← mkRule26Theorem b (counter + 1) i j
    return .lam Name.anonymous t innerBody default
  | _ =>
    let goals := getDisjunctiveGoals e #[]
    let iIdx := (counter - 1) - i
    orIntro goals j (Expr.bvar iIdx)

/-- Assuming e has the form e1 ∧ e2 ∧ ... ∧ en, returns an array #[e1, e2, ... en].
    Note: If e has the form (e1a ∧ e1b) ∧ e2 ∧ ... ∧ en, then the conjunction (e1a ∧ e1b) will
    be considered e1 (and the conjunction e1 will not be broken down further). This decision is made
    to reflect the form of the conjunction assumed by ProofReconstruction.lean's `andGet` -/
partial def getConjunctiveHypotheses (e : Expr) (hyps : Array Expr) : Array Expr :=
  match e.consumeMData with
  | Expr.app (Expr.app (Expr.const ``And _) e1) e2 => getConjunctiveHypotheses e2 (hyps.push e1)
  | _ => hyps.push e

partial def mkRule27Theorem (e : Expr) (i : Nat) (j : Nat) : MetaM Expr := do
  match e.consumeMData with
  | Expr.forallE _ t b _ =>
    let hyps := (getConjunctiveHypotheses t #[]).toList
    let goals := getDisjunctiveGoals b #[]
    let iHypProof ← andGet hyps i (Expr.bvar 0)
    let innerBody ← orIntro goals j iHypProof
    return .lam Name.anonymous t innerBody default
  | _ => throwError "{e} has the wrong shape for rule27"

/-- s ∨ s ↦ s -/
def applyRule1 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``Or _) e1) e2 =>
    if e1 == e2 then some e1
    else none
  | _ => none

/-- ¬s ∨ s ↦ True -/
def applyRule2 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``Or _) e1) e2 =>
    if e1 == Expr.app (Expr.const ``Not []) e2 then some (mkConst ``True)
    else none
  | _ => none

/-- s ∨ ¬s ↦ True -/
def applyRule2Sym (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``Or _) e1) e2 =>
    if e2 == Expr.app (Expr.const ``Not []) e1 then some (mkConst ``True)
    else none
  | _ => none

/-- s ∨ True ↦ True -/
def applyRule3 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``Or _) _) e2 =>
    if e2 == mkConst ``True then some (mkConst ``True)
    else none
  | _ => none

/-- True ∨ s ↦ True -/
def applyRule3Sym (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``Or _) e1) _ =>
    if e1 == mkConst ``True then some (mkConst ``True)
    else none
  | _ => none

/-- s ∨ False ↦ s -/
def applyRule4 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``Or _) e1) e2 =>
    if e2 == mkConst ``False then some e1
    else none
  | _ => none

/-- False ∨ s ↦ s -/
def applyRule4Sym (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``Or _) e1) e2 =>
    if e1 == mkConst ``False then some e2
    else none
  | _ => none

/-- s = s ↦ True -/
def applyRule5 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) e1) e2 =>
    if e1 == e2 then some (mkConst ``True)
    else none
  | _ => none

/-- s = True ↦ s -/
def applyRule6 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) e1) e2 =>
    if e2 == mkConst ``True then some e1
    else none
  | _ => none

/-- True = s ↦ s -/
def applyRule6Sym (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) e1) e2 =>
    if e1 == mkConst ``True then some e2
    else none
  | _ => none

/-- Not False ↦ True -/
def applyRule7 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.const ``Not _) (Expr.const ``False _) => some (mkConst ``True)
  | _ => none

/-- s ∧ s ↦ s -/
def applyRule8 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``And _) e1) e2 =>
    if e1 == e2 then some e1
    else none
  | _ => none

/-- ¬s ∧ s ↦ False -/
def applyRule9 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``And _) e1) e2 =>
    if e1 == Expr.app (Expr.const ``Not []) e2 then some (mkConst ``False)
    else none
  | _ => none

/-- s ∧ ¬s ↦ False -/
def applyRule9Sym (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``And _) e1) e2 =>
    if e2 == Expr.app (Expr.const ``Not []) e1 then some (mkConst ``False)
    else none
  | _ => none

/-- s ∧ True ↦ s -/
def applyRule10 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``And _) e1) e2 =>
    if e2 == mkConst ``True then some e1
    else none
  | _ => none

/-- True ∧ s ↦ s -/
def applyRule10Sym (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``And _) e1) e2 =>
    if e1 == mkConst ``True then some e2
    else none
  | _ => none

/-- s ∧ False ↦ False -/
def applyRule11 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``And _) _) e2 =>
    if e2 == mkConst ``False then some (mkConst ``False)
    else none
  | _ => none

/-- False ∧ s ↦ False -/
def applyRule11Sym (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``And _) e1) _ =>
    if e1 == mkConst ``False then some (mkConst ``False)
    else none
  | _ => none

/-- s ≠ s ↦ False -/
def applyRule12 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.app (Expr.const ``Ne _) _) e1) e2 =>
    if e1 == e2 then some (mkConst ``False)
    else none
  | _ => none

/-- s = False ↦ ¬s -/
def applyRule13 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) e1) e2 =>
    if e2 == mkConst ``False then some (mkApp (mkConst ``Not) e1)
    else none
  | _ => none

/-- False = s ↦ ¬s -/
def applyRule13Sym (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) e1) e2 =>
    if e1 == mkConst ``False then some (mkApp (mkConst ``Not) e2)
    else none
  | _ => none

/-- Not True ↦ False -/
def applyRule14 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.const ``Not _) (Expr.const ``True _) => some (mkConst ``False)
  | _ => none

/-- ¬¬s ↦ s -/
def applyRule15 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.const ``Not _) (Expr.app (Expr.const ``Not _) e') => some e'
  | _ => none

/-- True → s ↦ s -/
def applyRule16 (e : Expr) : Option Expr :=
  match e with
  | Expr.forallE _ t b _ =>
    if t == mkConst ``True then some b
    else none
  | _ => none

/-- False → s ↦ True -/
def applyRule17 (e : Expr) : Option Expr :=
  match e with
  | Expr.forallE _ t _ _ =>
    if t == mkConst ``False then some (mkConst ``True)
    else none
  | _ => none

/-- s → False ↦ ¬s -/
def applyRule18 (e : Expr) : RuleM (Option Expr) := do
  match e with
  | Expr.forallE _ t b _ =>
    if b == mkConst ``False && (← inferType t).isProp then return some (mkApp (mkConst ``Not) t)
    else return none
  | _ => return none

/-- s → True ↦ True (we generalize this to (∀ _ : α, True) ↦ True) -/
def applyRule19 (e : Expr) : Option Expr := do
  match e with
  | Expr.forallE _ _ b _ =>
    if b == mkConst ``True then some (mkConst ``True)
    else none
  | _ => none

/-- s → ¬s ↦ ¬s -/
def applyRule20 (e : Expr) : Option Expr := do
  match e with
  | Expr.forallE _ t b _ =>
    if b == Expr.app (Expr.const ``Not []) t then some b
    else none
  | _ => none

/-- ¬s → s ↦ s -/
def applyRule21 (e : Expr) : Option Expr := do
  match e with
  | Expr.forallE _ t b _ =>
    if t == Expr.app (Expr.const ``Not []) b then some b
    else none
  | _ => none

/-- s → s ↦ True -/
def applyRule22 (e : Expr) : RuleM (Option Expr) := do
  match e with
  | Expr.forallE _ t b _ =>
    if t == b && (← inferType t).isProp then return some (mkConst ``True)
    else return none
  | _ => return none

/-- ∀ p : Prop, f(p) ↦ f(True) ∧ f(False) -/
def applyRule23 (e : Expr) : RuleM (Option Expr) := do
  match e with
  | Expr.forallE _ t b _ =>
    if t.isProp && (← inferType e).isProp then
      let bTrue := b.instantiate1 (mkConst ``True)
      let bFalse := b.instantiate1 (mkConst ``False)
      mkAppM ``And #[bTrue, bFalse]
    else return none
  | _ => return none

/-- ∃ p : Prop, f(p) ↦ f True ∨ f False -/
def applyRule24 (e : Expr) : RuleM (Option Expr) := do
  match e with
  | Expr.app (Expr.app (Expr.const ``Exists _) t) b =>
    if t.isProp then
      let bTrue ← whnf $ mkApp b (mkConst ``True)
      let bFalse ← whnf $ mkApp b (mkConst ``False)
      mkAppM ``Or #[bTrue, bFalse]
    else return none
  | _ => return none

partial def applyRule25Helper (e : Expr) (hyps : Array Expr) : RuleM (Option (Nat × Nat)) := do
  match e.consumeMData with
  | Expr.forallE _ t b _ =>
    let findNegation (h : Expr) : Bool := -- h = ¬t or t = ¬h
      h == Expr.app (Expr.const ``Not []) t || t == Expr.app (Expr.const ``Not []) h
    match hyps.findIdx? findNegation with
    | some hIdx =>
      let tIdx := hyps.size
      if t == Expr.app (Expr.const ``Not []) hyps[hIdx]! then return some (tIdx, hIdx)
      else return some (hIdx, tIdx)
    | none => applyRule25Helper b (hyps.push t)
  | _ => return none

/-- (s1 → s2 → ... → sn → v) ↦ True if there exists i and j such that si = ¬sj
    Since this rule will require a more involved proof reconstruction, rather than returning the
    resulting expression as in previous applyRule functions, we return the two indices of the hypotheses
    that directly contradict each other. Specifically, if si = ¬sj, then we return some (i, j). -/
def applyRule25 (e : Expr) : RuleM (Option (Nat × Nat)) := applyRule25Helper e #[]

partial def applyRule26Helper (e : Expr) (hyps : Array Expr) : RuleM (Option (Nat × Nat)) := do
  match e.consumeMData with
  | e@(Expr.forallE ..) => Meta.forallTelescope e fun xs b => do
    let tys ← (xs.mapM Meta.inferType : MetaM (Array Expr))
    applyRule26Helper b (hyps.append tys)
  | _ =>
    if !(← inferType e).isProp then return none -- Prevents applying rule26 to expressions like Nat → Nat
    let goals := getDisjunctiveGoals e #[]
    let mut goalIdx := 0
    for goal in goals do
      match hyps.findIdx? (fun hyp => hyp == goal) with
      | some hypIdx => return some (hypIdx, goalIdx)
      | none => goalIdx := goalIdx + 1
    return none

/-- (s1 → s2 → ... → sn → v1 ∨ ... ∨ vm) ↦ True if there exists i and j such that si = vj
    Since this rule will require a more involved proof reconstruction, rather than returning the
    resulting expression as in previous applyRule functions, we return the index of the hypothesis si and
    the index of the conclusion vj. Specifically, if si = vj, then we return some (i, j) -/
def applyRule26 (e : Expr) : RuleM (Option (Nat × Nat)) := applyRule26Helper e #[]

/-- (s1 ∧ s2 ∧ ... ∧ sn → v1 ∨ ... ∨ vm) ↦ True if there exists i and j such that si = vj
    Since this rule will require a more involved proof reconstruction, rather than returning the
    resulting expression as in previous applyRule functions, we return the index of the hypothesis si
    and the inddex of the conclusion vj. Specifically, if si = vj, then we return some (i, j) -/
partial def applyRule27 (e : Expr) : RuleM (Option (Nat × Nat)) := do
  match e.consumeMData with
  | e@(Expr.forallE ..) => Meta.forallBoundedTelescope e (some 1) fun xs b => do
    if !(← inferType b).isProp then return none -- Prevents applying rule27 to expressions like Nat → Nat
    let t ← inferType xs[0]!
    let hyps := getConjunctiveHypotheses t #[]
    let goals := getDisjunctiveGoals b #[]
    let mut goalIdx := 0
    for goal in goals do
      match hyps.findIdx? (fun hyp => hyp == goal) with
      | some hypIdx => return some (hypIdx, goalIdx)
      | none => goalIdx := goalIdx + 1
    return none
  | _ => return none

/-- s1 ↔ s2 ↦ s1 = s2 -/
def applyRule28 (e : Expr) : Option Expr :=
  match e with
  | Expr.app (Expr.app (Expr.const ``Iff _) e1) e2 => some $ mkApp3 (mkConst ``Eq [levelOne]) (mkSort levelZero) e1 e2
  | _ => none

/-- Returns the rule theorem corresponding to boolSimpRule with the first argument applied.

    Note that this function assumes that `boolSimpRule` has already been shown to be applicable to `originalExp` so
    this is not rechecked (e.g. for rule1, this function does not check that the two propositions in the disjunction
    are actually equal, it assumes that this is the case from the fact that rule1 was applied) -/
def getBoolSimpRuleTheorem (boolSimpRule : BoolSimpRule) (originalExp : Expr) (ijOpt : Option (Nat × Nat)) : MetaM Expr :=
  match boolSimpRule with
  | rule1 => -- s ∨ s ↦ s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``Or _) e1) _ => return mkApp (mkConst ``rule1Theorem) e1
    | _ => throwError "Invalid orignalExp {originalExp} for rule1"
  | rule2 => -- ¬s ∨ s ↦ True
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``Or _) _) e2 => return mkApp (mkConst ``rule2Theorem) e2
    | _ => throwError "Invalid originalExp {originalExp} for rule2"
  | rule2Sym => -- s ∨ ¬s ↦ True
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``Or _) e1) _ => return mkApp (mkConst ``rule2SymTheorem) e1
    | _ => throwError "Invalid originalExp {originalExp} for rule2Sym"
  | rule3 => -- s ∨ True ↦ True
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``Or _) e1) _ => return mkApp (mkConst ``rule3Theorem) e1
    | _ => throwError "Invalid originalExp {originalExp} for rule3"
  | rule3Sym => -- True ∨ s ↦ True
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``Or _) _) e2 => return mkApp (mkConst ``rule3SymTheorem) e2
    | _ => throwError "Invalid originalExp {originalExp} for rule3Sym"
  | rule4 => -- s ∨ False ↦ s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``Or _) e1) _ => return mkApp (mkConst ``rule4Theorem) e1
    | _ => throwError "Invalid originalExp {originalExp} for rule4"
  | rule4Sym => -- False ∨ s ↦ s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``Or _) _) e2 => return mkApp (mkConst ``rule4SymTheorem) e2
    | _ => throwError "Invalid originalExp {originalExp} for rule4Sym"
  | rule5 => -- s = s ↦ True
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) e1) _ => Meta.mkAppM ``rule5Theorem #[e1]
    | _ => throwError "Invalid originalExp {originalExp} for rule5"
  | rule6 => -- s = True ↦ s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) e1) _ => return mkApp (mkConst ``rule6Theorem) e1
    | _ => throwError "Invalid originalExp {originalExp} for rule6"
  | rule6Sym => -- True = s ↦ s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) _) e2 => return mkApp (mkConst ``rule6SymTheorem) e2
    | _ => throwError "Invalid originalExp {originalExp} for rule6Sym"
  | rule7 => -- Not False ↦ True
    match originalExp.consumeMData with
    | Expr.app (Expr.const ``Not _) (Expr.const ``False _) => return mkConst ``rule7Theorem
    | _ => throwError "Invalid originalExp {originalExp} for rule7"
  | rule8 => -- s ∧ s ↦ s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``And _) e1) _ => return mkApp (mkConst ``rule8Theorem) e1
    | _ => throwError "Invalid orignalExp {originalExp} for rule8"
  | rule9 => -- ¬s ∧ s ↦ False
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``And _) _) e2 => return mkApp (mkConst ``rule9Theorem) e2
    | _ => throwError "Invalid originalExp {originalExp} for rule9"
  | rule9Sym => -- s ∧ ¬s ↦ False
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``And _) e1) _ => return mkApp (mkConst ``rule9SymTheorem) e1
    | _ => throwError "Invalid originalExp {originalExp} for rule9Sym"
  | rule10 => -- s ∧ True ↦ s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``And _) e1) _ => return mkApp (mkConst ``rule10Theorem) e1
    | _ => throwError "Invalid originalExp {originalExp} for rule10"
  | rule10Sym => -- True ∧ s ↦ s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``And _) _) e2 => return mkApp (mkConst ``rule10SymTheorem) e2
    | _ => throwError "Invalid originalExp {originalExp} for rule10Sym"
  | rule11 => -- s ∧ False ↦ False
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``And _) e1) _ => return mkApp (mkConst ``rule11Theorem) e1
    | _ => throwError "Invalid originalExp {originalExp} for rule11"
  | rule11Sym => -- False ∧ s ↦ False
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``And _) _) e2 => return mkApp (mkConst ``rule11SymTheorem) e2
    | _ => throwError "Invalid originalExp {originalExp} for rule11Sym"
  | rule12 => -- s ≠ s ↦ False
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.app (Expr.const ``Ne _) _) e1) _ => Meta.mkAppM ``rule12Theorem #[e1]
    | _ => throwError "Invalid originalExp {originalExp} for rule12"
  | rule13 => -- s = False ↦ ¬s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) e1) _ => return mkApp (mkConst ``rule13Theorem) e1
    | _ => throwError "Invalid originalExp {originalExp} for rule13"
  | rule13Sym => -- False = s ↦ ¬s
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.app (Expr.const ``Eq _) _) _) e2 => return mkApp (mkConst ``rule13SymTheorem) e2
    | _ => throwError "Invalid originalExp {originalExp} for rule13Sym"
  | rule14 => -- Not True ↦ False
    match originalExp.consumeMData with
    | Expr.app (Expr.const ``Not _) (Expr.const ``True _) => return mkConst ``rule14Theorem
    | _ => throwError "Invalid originalExp {originalExp} for rule14"
  | rule15 => -- ¬¬s ↦ s
    match originalExp.consumeMData with
    | Expr.app (Expr.const ``Not _) (Expr.app (Expr.const ``Not _) e') => return mkApp (mkConst ``rule15Theorem) e'
    | _ => throwError "Invalid originalExp {originalExp} for rule15"
  | rule16 => -- True → s ↦ s
    match originalExp.consumeMData with
    | Expr.forallE _ _ b _ => return mkApp (mkConst ``rule16Theorem) b
    | _ => throwError "Invalid originalExp {originalExp} for rule16"
  | rule17 => -- False → s ↦ True
    match originalExp.consumeMData with
    | Expr.forallE _ _ b _ => return mkApp (mkConst ``rule17Theorem) b
    | _ => throwError "Invalid originalExp {originalExp} for rule17"
  | rule18 => -- s → False ↦ ¬s
    match originalExp.consumeMData with
    | Expr.forallE _ t _ _ => return mkApp (mkConst ``rule18Theorem) t
    | _ => throwError "Invalid originalExp {originalExp} for rule18"
  | rule19 => -- s → True ↦ True (we generalize this to (∀ _ : α, True) ↦ True)
    match originalExp.consumeMData with
    | Expr.forallE _ t _ _ => Meta.mkAppM ``rule19Theorem #[t]
    | _ => throwError "Invalid originalExp {originalExp} for rule19"
  | rule20 => -- s → ¬s ↦ ¬s
    match originalExp.consumeMData with
    | Expr.forallE _ t _ _ => return mkApp (mkConst ``rule20Theorem) t
    | _ => throwError "Invalid originalExp {originalExp} for rule20"
  | rule21 => -- ¬s → s ↦ s
    match originalExp.consumeMData with
    | Expr.forallE _ _ b _ => return mkApp (mkConst ``rule21Theorem) b
    | _ => throwError "Invalid originalExp {originalExp} for rule21"
  | rule22 => -- s → s ↦ True
    match originalExp.consumeMData with
    | Expr.forallE _ _ b _ => return mkApp (mkConst ``rule22Theorem) b
    | _ => throwError "Invalid originalExp {originalExp} for rule22"
  | rule23 => -- ∀ p : Prop, f(p) ↦ f(True) ∧ f(False)
    match originalExp.consumeMData with
    | Expr.forallE n _ b _ => do
      let bFunction := Expr.lam n (mkSort levelZero) b BinderInfo.default
      return mkApp (mkConst ``rule23Theorem) bFunction
    | _ => throwError "Invalid originalExp {originalExp} for rule23"
  | rule24 => -- ∃ p : Prop, f(p) ↦ f True ∨ f False
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``Exists _) t) b => return mkApp (mkConst ``rule24Theorem) b
    | _ => throwError "Invalid originalExp {originalExp} for rule24"
  | rule25 => -- (s1 → s2 → ... → sn → v) ↦ True if there exists i and j such that si = ¬sj
    match ijOpt with
    | some (i, j) => do Meta.mkAppM ``eq_true #[← mkRule25Theorem originalExp 0 i j]
    | none => throwError "rule25 requires indices that were not passed into getBoolSimpRuleTheorem"
  | rule26 => -- (s1 → s2 → ... → sn → v1 ∨ ... ∨ vm) ↦ True if there exists i and j such that si = vj
    match ijOpt with
    | some (i, j) => do Meta.mkAppM ``eq_true #[← mkRule26Theorem originalExp 0 i j]
    | none => throwError "rule26 requires indices that were not passed into getBoolSimpRuleTheorem"
  | rule27 => -- (s1 ∧ s2 ∧ ... ∧ sn → v1 ∨ ... ∨ vm) ↦ True if there exists i and j such that si = vj
    match ijOpt with
    | some (i, j) => do Meta.mkAppM ``eq_true #[← mkRule27Theorem originalExp i j]
    | none => throwError "rule27 requires indices that were not passed into getBoolSimpRuleTheorem"
  | rule28 => -- s1 ↔ s2 ↦ s1 = s2
    match originalExp.consumeMData with
    | Expr.app (Expr.app (Expr.const ``Iff _) e1) e2 => return mkApp2 (mkConst ``rule28Theorem) e1 e2
    | _ => throwError "Invalid originalExpr {originalExp} for rule28"

def mkBoolSimpProof (substPos : ClausePos) (boolSimpRule : BoolSimpRule) (ijOpt : Option (Nat × Nat)) (premises : List Expr)
  (parents : List ProofParent) (transferExprs : Array Expr) (c : Clause) : MetaM Expr :=
  Meta.forallTelescope c.toForallExpr fun xs body => do
    let cLits := c.lits.map (fun l => l.map (fun e => e.instantiateRev xs))
    let (parentsLits, appliedPremises, transferExprs) ← instantiatePremises parents premises xs transferExprs
    let parentLits := parentsLits[0]!
    let appliedPremise := appliedPremises[0]!

    let mut proofCases : Array Expr := Array.mkEmpty parentLits.size
    for i in [:parentLits.size] do
      let lit := parentLits[i]!
      let pr : Expr ← Meta.withLocalDeclD `h lit.toExpr fun h => do
        if(i == substPos.lit) then
          let substLitPos : LitPos := ⟨substPos.side, substPos.pos⟩
          let boolSimpRuleThm ← getBoolSimpRuleTheorem boolSimpRule (← parentLits[substPos.lit]!.getAtPos! substLitPos) ijOpt

          let abstrLit ← (lit.abstractAtPos! substLitPos)
          let abstrExp := abstrLit.toExpr
          let abstrLam := mkLambda `x BinderInfo.default (mkSort levelZero) abstrExp
          let rwproof ← Meta.mkAppM ``Eq.mp #[← Meta.mkAppM ``congrArg #[abstrLam, boolSimpRuleThm], h]
          Meta.mkLambdaFVars #[h] $ ← orIntro (cLits.map Lit.toExpr) i $ rwproof
        else
          Meta.mkLambdaFVars #[h] $ ← orIntro (cLits.map Lit.toExpr) i h
      proofCases := proofCases.push pr
    let proof ← orCases (parentLits.map Lit.toExpr) proofCases
    Meta.mkLambdaFVars xs $ mkApp proof appliedPremise

/-- The list of rules that do not require the RuleM monad -/
def applyRulesList1 : List ((Expr → (Option Expr)) × BoolSimpRule) := [
  (applyRule1, rule1),
  (applyRule2, rule2),
  (applyRule2Sym, rule2Sym),
  (applyRule3, rule3),
  (applyRule3Sym, rule3Sym),
  (applyRule4, rule4),
  (applyRule4Sym, rule4Sym),
  (applyRule5, rule5),
  (applyRule6, rule6),
  (applyRule6Sym, rule6Sym),
  (applyRule7, rule7),
  (applyRule8, rule8),
  (applyRule9, rule9),
  (applyRule9Sym, rule9Sym),
  (applyRule10, rule10),
  (applyRule10Sym, rule10Sym),
  (applyRule11, rule11),
  (applyRule11Sym, rule11Sym),
  (applyRule12, rule12),
  (applyRule13, rule13),
  (applyRule13Sym, rule13Sym),
  (applyRule14, rule14),
  (applyRule15, rule15),
  (applyRule16, rule16),
  (applyRule17, rule17),
  (applyRule19, rule19),
  (applyRule20, rule20),
  (applyRule21, rule21),
  (applyRule28, rule28)
]

/-- The list of rules that do require the RuleM monad -/
def applyRulesList2 : List ((Expr → RuleM (Option Expr)) × BoolSimpRule) := [
  (applyRule18, rule18),
  (applyRule22, rule22),
  (applyRule23, rule23),
  (applyRule24, rule24)
]

/-- The list of rules for which indices must be returned -/
def applyRulesList3 : List ((Expr → RuleM (Option (Nat × Nat))) × BoolSimpRule) := [
  (applyRule25, rule25),
  (applyRule26, rule26),
  (applyRule27, rule27)
]

def applyBoolSimpRules (e : Expr) : RuleM (Option (Expr × BoolSimpRule)) := do
  for (applyRuleFn, rule) in applyRulesList1 do
    match applyRuleFn e with
    | some e' => return some (e', rule)
    | none => continue
  for (applyRuleFn, rule) in applyRulesList2 do
    match ← applyRuleFn e with
    | some e' => return some (e', rule)
    | none => continue
  return none

def applyBoolSimpRulesWithIndices (e : Expr) : RuleM (Option ((Nat × Nat) × BoolSimpRule)) := do
  for (applyRuleFn, rule) in applyRulesList3 do
    match ← applyRuleFn e with
    | some ij => return some (ij, rule)
    | none => continue
  return none

/-- Implements various Prop-related simplifications as described in "Superposition with First-Class Booleans and Inprocessing
    Clausification" and "Extensional Paramodulation for Higher-Order Logic and its Effective Implementation Leo-III" -/
def boolSimp : MSimpRule := fun c => do
  let c ← loadClause c
  trace[Rule.boolSimp] "Running boolSimp on {c.lits}"
  let fold_fn := fun acc e pos => do
    match acc.2 with
    | some _ => return acc -- If boolSimp ever succeeds, just return on first success
    | none =>
      let e := e.consumeMData -- We apply consumeMData before passing e into all of the rules so we don't need to constantly reapply it
      /-
        Try to apply each of the rules to e. If any of them succeed, perform the appropriate substitution and return
        the new clause along with a proof that the new clause can be obtained from the old one. If all of the rules fail,
        then return the original clause and none (which is simply the same acc we started with)
      -/
      match ← applyBoolSimpRules e with
      | some (e', boolSimpRule) =>
        if let some replacedMClause ← c.replaceAtPosUpdateType? pos e' then
          trace[Rule.boolSimp] "Replaced {e} with {e'} in {c.lits} to produce {replacedMClause.lits} via {boolSimpRule}"
          return (replacedMClause, mkBoolSimpProof pos boolSimpRule none)
        else
          return acc
      | none => -- If none of the first 24 rules worked, attempt rules 25, 26, and 27
        match ← applyBoolSimpRulesWithIndices e with
        | some (ij, boolSimpRule) =>
          if let some replacedMClause ← c.replaceAtPosUpdateType? pos (mkConst ``True) then
            trace[Rule.boolSimp] "Replaced {e} with True in {c.lits} to produce {replacedMClause.lits} via {boolSimpRule}"
            return (replacedMClause, mkBoolSimpProof pos boolSimpRule (some ij))
          else
            return acc
        | none => return acc -- If no bool simp rule can be applied, then return the original clause unchanged
  let (c', proofOpt) ← c.foldGreenM fold_fn (c, none)
  match proofOpt with
  | none => return none -- No substitutions were performed, so we don't need to yield any clause and we can return false
  | some proof =>
    let cp ← yieldClause c' "bool simp" $ some proof
    return some #[cp]


import MyNat.Definition
/-!
## Tactic : by_cases

## Summary

`by_cases h : P` does a cases split on whether `P` is true or false.

## Details

Some logic goals cannot be proved with `intro` and `apply` and `exact`.
The simplest example is the law of the excluded middle `¬ ¬ P → P`.
You can prove this using truth tables but not with `intro`, `apply` etc.
To do a truth table proof, the tactic `by_cases h : P` will turn a goal of
`⊢ ¬ ¬ P → P` into two goals

```
P : Prop,
h : P
⊢ ¬¬P → P

P : Prop,
h : ¬P
⊢ ¬¬P → P
```

Each of these can now be proved using `intro`, `apply`, `exact` and `exfalso`.
Remember though that in these simple logic cases, high-powered logic
tactics like `cc` and `tauto!` will just prove everything.
-/


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/

import tactic.monotonicity
import order.basic

open tactic interactive (parse) interactive (loc.ns)
     interactive.types (texpr location) lean.parser (tk)

local postfix `?`:9001 := optional

/--
    But : change _ = _  `name`   `at` h
    c'est en deux temps :
        1. change _ = _ motif at
        2. rw name

    même syntaxe que bidule  tk parse `using` appliquer change avant

-/
meta def apply_fun_name (e : pexpr) (h : name) (M : option pexpr) : tactic unit :=
do {
  H ← get_local h,
  t ← infer_type H,
  match t with
  | `(%%l = %%r) := do
      ltp ← infer_type l,
      mv ← mk_mvar,
      to_expr ``(congr_arg (%%e : %%ltp → %%mv) %%H) >>= note h,
      clear H
  | _ := skip
  end,
  -- let's try to force β-reduction at `h`
  try (tactic.interactive.dsimp tt [] [] (loc.ns [h])
         {eta := false, beta := true})
} <|> fail ("failed to apply " ++ to_string e ++ " at " ++ to_string h)

namespace tactic.interactive
/--
Apply a function to some local assumptions which are either equalities
or inequalities. For instance, if the context contains `h : a = b` and
some function `f` then `apply_fun f at h` turns `h` into
`h : f a = f b`. When the assumption is an inequality `h : a ≤ b`, a side
goal `monotone f` is created, unless this condition is provided using
`apply_fun f at h using P` where `P : monotone f`, or the `mono` tactic
can prove it.

Typical usage is:
```lean
open function

example (X Y Z : Type) (f : X → Y) (g : Y → Z) (H : injective $ g ∘ f) :
  injective f :=
begin
  intros x x' h,
  apply_fun g at h,
  exact H h
end
```
 -/
meta def apply_fun (q : parse texpr) (locs : parse location)
  (lem : parse (tk "using" *> texpr)?) : tactic unit :=
--do e ← tactic.i_to_expr q,
   match locs with
   | (loc.ns l) := do
      l.mmap' (λ l, match l with
      | some h :=  apply_fun_name q h lem
      | none := skip
      end)
   | wildcard := do ctx ← local_context,
                    ctx.mmap' (λ h, apply_fun_name q h.local_pp_name lem)
   end
end tactic.interactive

add_tactic_doc
{ name       := "apply_fun",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.apply_fun],
  tags       := ["context management"] }

open function

example (X Y Z : Type) (f : X → Y) (g : Y → Z) (H : injective $ g ∘ f) :
  injective f :=
begin
  intros x x' h,
  apply_fun g at h,
  exact H h
end


import Smt

theorem hypothetical_syllogism (p q r : Bool) : (p → q) → (q → r) → p → r := by
  smt
  simp_all


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon

Lemmas about traversing collections.

Inspired by:

    The Essence of the Iterator Pattern
    Jeremy Gibbons and Bruno César dos Santos Oliveira
    In Journal of Functional Programming. Vol. 19. No. 3&4. Pages 377−402. 2009.
    http://www.cs.ox.ac.uk/jeremy.gibbons/publications/iterator.pdf
-/

import tactic.cache
import category.traversable.basic

universe variables u

open is_lawful_traversable
open function (hiding comp)
open functor

attribute [functor_norm] is_lawful_traversable.naturality
attribute [simp] is_lawful_traversable.id_traverse

namespace traversable

variable {t : Type u → Type u}
variables [traversable t] [is_lawful_traversable t]
variables F G : Type u → Type u

variables [applicative F] [is_lawful_applicative F]
variables [applicative G] [is_lawful_applicative G]
variables {α β γ : Type u}
variables g : α → F β
variables h : β → G γ
variables f : β → γ

def pure_transformation : applicative_transformation id F :=
{ app := @pure F _,
  preserves_pure' := λ α x, rfl,
  preserves_seq' := λ α β f x, by simp; refl }

@[simp] theorem pure_transformation_apply {α} (x : id α) :
  (pure_transformation F) x = pure x := rfl

variables {F G} (x : t β)

lemma map_eq_traverse_id : map f = @traverse t _ _ _ _ _ (id.mk ∘ f) :=
funext $ λ y, (traverse_eq_map_id f y).symm

theorem map_traverse (x : t α) :
  map f <$> traverse g x = traverse (map f ∘ g) x :=
begin
  rw @map_eq_traverse_id t _ _ _ _ f,
  refine (comp_traverse (id.mk ∘ f) g x).symm.trans _,
  congr, apply comp.applicative_comp_id
end

theorem traverse_map (f : β → F γ) (g : α → β) (x : t α) :
  traverse f (g <$> x) = traverse (f ∘ g) x :=
begin
  rw @map_eq_traverse_id t _ _ _ _ g,
  refine (comp_traverse f (id.mk ∘ g) x).symm.trans _,
  congr, apply comp.applicative_id_comp
end

lemma pure_traverse (x : t α) :
  traverse pure x = (pure x : F (t α)) :=
by have : traverse pure x = pure (traverse id.mk x) :=
     (naturality (pure_transformation F) id.mk x).symm;
   rwa id_traverse at this

lemma id_sequence (x : t α) :
  sequence (id.mk <$> x) = id.mk x :=
by simp [sequence, traverse_map, id_traverse]; refl

lemma comp_sequence (x : t (F (G α))) :
  sequence (comp.mk <$> x) = comp.mk (sequence <$> sequence x) :=
by simp [sequence, traverse_map]; rw ← comp_traverse; simp [map_id]

lemma naturality' (η : applicative_transformation F G) (x : t (F α)) :
  η (sequence x) = sequence (@η _ <$> x) :=
by simp [sequence, naturality, traverse_map]

@[functor_norm]
lemma traverse_id :
  traverse id.mk = (id.mk : t α → id (t α)) :=
by ext; simp [id_traverse]; refl

@[functor_norm]
lemma traverse_comp (g : α → F β) (h : β → G γ) :
  traverse (comp.mk ∘ map h ∘ g) =
  (comp.mk ∘ map (traverse h) ∘ traverse g : t α → comp F G (t γ)) :=
by ext; simp [comp_traverse]

lemma traverse_eq_map_id' (f : β → γ) :
  traverse (id.mk ∘ f) =
  id.mk ∘ (map f : t β → t γ) :=
by ext;rw traverse_eq_map_id

-- @[functor_norm]
lemma traverse_map' (g : α → β) (h : β → G γ) :
  traverse (h ∘ g) =
  (traverse h ∘ map g : t α → G (t γ)) :=
by ext; simp [traverse_map]

lemma map_traverse' (g : α → G β) (h : β → γ) :
  traverse (map h ∘ g) =
  (map (map h) ∘ traverse g : t α → G (t γ)) :=
by ext; simp [map_traverse]

lemma naturality_pf (η : applicative_transformation F G) (f : α → F β) :
  traverse (@η _ ∘ f) = @η _ ∘ (traverse f : t α → F (t β)) :=
by ext; simp [naturality]

end traversable


import category.basic
import heap.basic
import data.finmap
import tactic.omega
import tactic.linarith

namespace memory

variables value : Type

variables {value}

def maplet (x : ptr) (v : value) : heap value :=
finmap.singleton x v

def heap.mk (l : list (ptr × value)) : heap value :=
(l.map $ λ x : ptr × value, (⟨x.1,x.2⟩ : sigma $ λ _, value)).to_finmap

@[simp]
lemma heap.mk_nil : heap.mk [] = (∅ : heap value) := rfl

@[simp]
lemma heap.mk_cons (p v) (l : list (ptr × value)) : heap.mk ((p,v) :: l) = maplet p v ∪ heap.mk l := rfl

@[simp]
lemma mem_heap.mk (p) (l : list (ptr × value)) : p ∈ heap.mk l ↔ ∃ v, (p,v) ∈ l :=
iff.trans
  (finmap.mem_list_to_finmap _ _)
  (exists_congr $ λ v,
    by simp [list.mem_map]; split;
       [ { rintro ⟨a,b,h,⟨⟩,⟨⟩⟩, exact h },
         { intro h, refine ⟨_,_,h,rfl,rfl⟩ }])

def erase_all (p : ptr) (n : ℕ) (m : heap value) : heap value :=
(list.range n).foldl (λ m i, finmap.erase (p + i) m) m

@[simp] lemma erase_all_zero (p : ptr) (m : heap value) : erase_all p 0 m = m := rfl

lemma erase_all_succ (p : ptr) (n : ℕ) (m : heap value) : erase_all p n.succ m = finmap.erase (p+n) (erase_all p n m) :=
by simp [erase_all, list.foldl_eq_foldr' _ m (list.range _),list.range_concat]

lemma erase_all_one_add (p : ptr) (n : ℕ) (m : heap value) : erase_all p (1+n) m = finmap.erase (p+n) (erase_all p n m) :=
by rw nat.add_comm; apply erase_all_succ p _ m

lemma erase_all_succ' (p : ptr) (n : ℕ) (m : heap value) : erase_all p n.succ m = finmap.erase p (erase_all (p+1) n m) :=
by { simp only [erase_all,list.range_succ_eq_map],
     rw [list.foldl_eq_of_comm',list.foldl_map],
     congr, simp only [add_zero, nat.add_comm, add_left_comm],
     simp only [finmap.erase_erase, forall_3_true_iff, eq_self_iff_true] }

lemma erase_all_one_add' (p : ptr) (n : ℕ) (m : heap value) : erase_all p (1+n) m = finmap.erase p (erase_all (p+1) n m) :=
by rw nat.add_comm; apply erase_all_succ' p _ m

open list nat

lemma mem_erase_all (p p' : ptr) (m : heap value) : Π {n}, p ∈ erase_all p' n m ↔ ¬ p ∈ range' p' n ∧ p ∈ m
| 0 := by simp [erase_all_zero]
| (succ n) := by { simp only [erase_all_succ, mem_cons_iff, add_comm, mem_range', finmap.mem_erase, ne.def, add_left_comm, mem_erase_all, not_and_distrib],
                   repeat { rw ← and_assoc }, apply and_congr _ (iff.refl _),
                   clear mem_erase_all, dsimp [ptr] at p p', omega nat }

open finmap

@[simp]
lemma mem_maplet (p q : ptr) (v : value) : p ∈ maplet q v ↔ p = q :=
by simp only [maplet, not_mem_empty, finmap.mem_singleton, iff_self, or_false]

lemma disjoint_maplet (p) (v : value) (frame : heap value) : disjoint (maplet p v) frame ↔ ¬ p ∈ frame :=
begin
  split,
  { simp [disjoint.symm_iff], intros h h',
    specialize h _ h', simp only [maplet,finmap.mem_singleton] at h, exact h rfl },
  { intros h p' h', simp only [maplet,finmap.not_mem_empty,finmap.mem_singleton] at h',
    subst h', exact h }
end

lemma maplet_add (p : ptr) (v : value) (h : heap value) (hp : p ∉ h) :
  some (maplet p v) ⊗ some h = some (h.insert p v) :=
by rw ← union_eq_add_of_disjoint; [refl, { rw disjoint_maplet; exact hp }]

@[simp]
lemma heap.mem_mk (p : ptr) (vs : list (ptr × value)) : p ∈ heap.mk vs ↔ p ∈ vs.map prod.fst :=
by { simp only [heap.mk,mem_list_to_finmap,_root_.and_comm (_ ∈ vs),_root_.and_assoc,  list.mem_map,
                iff_self, exists_eq_left, exists_and_distrib_left, heq_iff_eq, list.map, prod.exists] }

instance : has_le (heap value) :=
{ le := λ x y, ∀ a b, x.lookup a = some b → y.lookup a = some b }

instance : preorder (heap value) :=
{ le_refl := λ h a b H, H,
  le_trans := λ h₀ h₁ h₂ H H' p _ HH, H' _ _ (H _ _ HH),
  .. memory.has_le
  }

lemma le_of_add_eq_some {h₀ h₁ : heap value} (h' : heap value) (H : some h₁ = some h₀ ⊗ some h') : h₀ ≤ h₁ :=
λ p v HH,
have HH' : _, from eq_union_of_eq_add H,
by rw [HH',lookup_union_left,HH]; apply mem_of_lookup_eq_some HH

lemma erase_all_union_mk_self (p : ptr) (vs : list value) (h : heap value) (H : heap.mk (vs.enum_from p) ≤ h) :
  erase_all p (length vs) h ∪ heap.mk (vs.enum_from p) = h :=
begin
  induction vs generalizing p; simp [length,enum_from,erase_all_one_add',union_assoc],
  rw [← union_assoc,maplet,erase_union_singleton,vs_ih],
  { transitivity'; [skip, exact H], dsimp [enum_from],
    intros p' v Hp, rw [lookup_union_right,Hp],
    simp [maplet], intro Hp', subst p',
    replace Hp := mem_of_lookup_eq_some Hp,
    simp at Hp, change ℕ at p, clear_except Hp,
    replace Hp := Hp.1, omega nat, },
  clear vs_ih, replace H : h.lookup p = some vs_hd,
  { apply H, simp [enum_from,maplet,lookup_singleton_eq] },
  generalize hq : p + 1 = q,
  have : p < q,
  { rw ← hq, apply lt_add_one },
  clear hq, induction vs_tl with v vs,
  { simp [H] },
  { simp [length,erase_all_one_add], rw [lookup_erase_ne,vs_tl_ih],
    apply ne_of_lt, linarith }
end

lemma mem_of_mem_of_le {h₀ h₁ : heap value} (H : h₀ ≤ h₁) : ∀ x ∈ h₀, x ∈ h₁ :=
by intros p; rw [mem_iff,mem_iff]; apply exists_imp_exists; exact H p

lemma insert_maplet  (p) (v v' : value) : finmap.insert p v (maplet p v') = maplet p v :=
finmap.insert_singleton_eq

lemma disjoint_mono {ha hb ha' hb' : heap value} (H₀ : ha' ≤ ha) (H₁ : hb' ≤ hb) :
  disjoint ha hb → disjoint ha' hb' :=
begin
  intros H₂ x H₃ H₄,
  replace H₃ := mem_of_mem_of_le H₀ _ H₃,
  replace H₄ := mem_of_mem_of_le H₁ _ H₄,
  exact H₂ _ H₃ H₄,
end

lemma add_inj {h₀ h₁ : option (heap value)} (hh : option (heap value)) (hh₀ hh₁ : heap value)
  (H₀ : some hh₀ = h₀ ⊗ hh) (H₁ : some hh₁ = h₁ ⊗ hh) (H₂ : h₀ ⊗ hh = h₁ ⊗ hh) :
  h₀ = h₁ :=
begin
  cases h₀; [skip, cases h₁], cases H₀, cases H₁, cases hh, cases H₀,
  rw [← union_eq_add_of_disjoint (disjoint_of_add _ H₀),← union_eq_add_of_disjoint (disjoint_of_add _ H₁),option.some_inj,finmap.union_cancel] at H₂, rw H₂,
  all_goals { apply disjoint_of_add, assumption },
end

end memory

namespace separation
open memory

structure tptr (val : Type) (α : Type*) :=
(get : ptr)

variables {val : Type} {α : Type*} {β : Type*}
include val
local notation `tptr` := tptr val

instance : decidable_linear_order (tptr α) :=
decidable_linear_order.lift tptr.get (λ ⟨_,_,x⟩ ⟨_,_,y⟩, congr_arg _) (by apply_instance)

def tptr.recast (β) (p : tptr α) : tptr β :=
{ get := p.get }

def tptr.add (p : tptr α) (n : ℕ) : tptr α :=
{ get := p.get + n }

infixl ` +. `:65 := tptr.add

@[simp, separation_logic]
lemma offset_zero (p : tptr α) : p +. 0 = p := by cases p; refl

@[simp, separation_logic]
lemma offset_offset (p : tptr α) (n m : ℕ) : p +. n +. m = p +. (n + m) :=
congr_arg _ (nat.add_assoc _ _ _)

lemma gt_offset_of_gt {α} (p : tptr α) {n : ℕ} (h : n > 0) : p +. n > p :=
by cases p; dsimp [(+.)]; apply lt_add_of_pos_right _ h

lemma le_offset (p : tptr α) {n : ℕ} : p ≤ p +. n :=
by cases p; dsimp [(+.)]; apply nat.le_add_right

lemma offset_ne (p : tptr α) {n : ℕ} (h : n > 0) : p +. n ≠ p :=
ne_of_gt (gt_offset_of_gt _ h)

@[simp, separation_logic]
lemma recast_offset (p : tptr α) (n : ℕ) : (p +. n).recast β = (p.recast β +. n) := rfl

lemma recast_le_iff_le_recast (p : tptr α) (q : tptr β) :
  p.recast β ≤ q ↔ p ≤ q.recast α :=
by cases p; cases q; refl

@[simp]
lemma tptr.mk_offset (p : ptr) (n : ℕ) : tptr.mk val α p +. n = tptr.mk val α (p + n) := rfl

open list

lemma some_mk_enum_from_cons (p : ptr) (x : val) (xs : list val) :
  some (heap.mk (enum_from p (x :: xs))) = some (maplet p x) ⊗ some (heap.mk $ xs.enum_from $ p + 1) :=
begin
  rw ← union_eq_add_of_disjoint,
  { simp [enum_from] },
  intro p', simp, intros h h', subst p',
  cases nat.not_succ_le_self _ h'
end

end separation