/-
Copyright (c) 2014 Parikshit Khanna. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.option.defs
import Mathlib.logic.basic
import Mathlib.tactic.cache
import Mathlib.PostPort

universes u_1 u v w u_2

namespace Mathlib

/-!
## Definitions on lists

This file contains various definitions on lists. It does not contain
proofs about these definitions, those are contained in other files in `data/list`
-/

namespace list

/-- Returns whether a list is []. Returns a boolean even if `l = []` is not decidable. -/
def is_nil {α : Type u_1} : List α → Bool := sorry

protected instance has_sdiff {α : Type u} [DecidableEq α] : has_sdiff (List α) :=
  has_sdiff.mk list.diff

/-- Split a list at an index.

     split_at 2 [a, b, c] = ([a, b], [c]) -/
def split_at {α : Type u} : ℕ → List α → List α × List α := sorry

/-- An auxiliary function for `split_on_p`. -/
def split_on_p_aux {α : Type u} (P : α → Prop) [decidable_pred P] :
    List α → (List α → List α) → List (List α) :=
  sorry

/-- Split a list at every element satisfying a predicate. -/
def split_on_p {α : Type u} (P : α → Prop) [decidable_pred P] (l : List α) : List (List α) :=
  split_on_p_aux P l id

/-- Split a list at every occurrence of an element.

    [1,1,2,3,2,4,4].split_on 2 = [[1,1],[3],[4,4]] -/
def split_on {α : Type u} [DecidableEq α] (a : α) (as : List α) : List (List α) :=
  split_on_p (fun (_x : α) => _x = a) as

/-- Concatenate an element at the end of a list.

     concat [a, b] c = [a, b, c] -/
@[simp] def concat {α : Type u} : List α → α → List α := sorry

/-- `head' xs` returns the first element of `xs` if `xs` is non-empty;
it returns `none` otherwise -/
@[simp] def head' {α : Type u} : List α → Option α := sorry

/-- Convert a list into an array (whose length is the length of `l`). -/
def to_array {α : Type u} (l : List α) : array (length l) α :=
  d_array.mk fun (v : fin (length l)) => nth_le l (subtype.val v) sorry

/-- "inhabited" `nth` function: returns `default` instead of `none` in the case
  that the index is out of bounds. -/
@[simp] def inth {α : Type u} [h : Inhabited α] (l : List α) (n : ℕ) : α := option.iget (nth l n)

/-- Apply a function to the nth tail of `l`. Returns the input without
  using `f` if the index is larger than the length of the list.

     modify_nth_tail f 2 [a, b, c] = [a, b] ++ f [c] -/
@[simp] def modify_nth_tail {α : Type u} (f : List α → List α) : ℕ → List α → List α := sorry

/-- Apply `f` to the head of the list, if it exists. -/
@[simp] def modify_head {α : Type u} (f : α → α) : List α → List α := sorry

/-- Apply `f` to the nth element of the list, if it exists. -/
def modify_nth {α : Type u} (f : α → α) : ℕ → List α → List α := modify_nth_tail (modify_head f)

/-- Apply `f` to the last element of `l`, if it exists. -/
@[simp] def modify_last {α : Type u} (f : α → α) : List α → List α := sorry

/-- `insert_nth n a l` inserts `a` into the list `l` after the first `n` elements of `l`
 `insert_nth 2 1 [1, 2, 3, 4] = [1, 2, 1, 3, 4]`-/
def insert_nth {α : Type u} (n : ℕ) (a : α) : List α → List α := modify_nth_tail (List.cons a) n

/-- Take `n` elements from a list `l`. If `l` has less than `n` elements, append `n - length l`
elements `default α`. -/
def take' {α : Type u} [Inhabited α] (n : ℕ) : List α → List α := sorry

/-- Get the longest initial segment of the list whose members all satisfy `p`.

     take_while (λ x, x < 3) [0, 2, 5, 1] = [0, 2] -/
def take_while {α : Type u} (p : α → Prop) [decidable_pred p] : List α → List α := sorry

/-- Fold a function `f` over the list from the left, returning the list
  of partial results.

     scanl (+) 0 [1, 2, 3] = [0, 1, 3, 6] -/
def scanl {α : Type u} {β : Type v} (f : α → β → α) : α → List β → List α := sorry

/-- Auxiliary definition used to define `scanr`. If `scanr_aux f b l = (b', l')`
then `scanr f b l = b' :: l'` -/
def scanr_aux {α : Type u} {β : Type v} (f : α → β → β) (b : β) : List α → β × List β := sorry

/-- Fold a function `f` over the list from the right, returning the list
  of partial results.

     scanr (+) 0 [1, 2, 3] = [6, 5, 3, 0] -/
def scanr {α : Type u} {β : Type v} (f : α → β → β) (b : β) (l : List α) : List β := sorry

/-- Product of a list.

     prod [a, b, c] = ((1 * a) * b) * c -/
def prod {α : Type u} [Mul α] [HasOne α] : List α → α := foldl Mul.mul 1

/-- Sum of a list.

     sum [a, b, c] = ((0 + a) + b) + c -/
-- Later this will be tagged with `to_additive`, but this can't be done yet because of import

-- dependencies.

def sum {α : Type u} [Add α] [HasZero α] : List α → α := foldl Add.add 0

/-- The alternating sum of a list. -/
def alternating_sum {G : Type u_1} [HasZero G] [Add G] [Neg G] : List G → G := sorry

/-- The alternating product of a list. -/
def alternating_prod {G : Type u_1} [HasOne G] [Mul G] [has_inv G] : List G → G := sorry

/-- Given a function `f : α → β ⊕ γ`, `partition_map f l` maps the list by `f`
  whilst partitioning the result it into a pair of lists, `list β × list γ`,
  partitioning the `sum.inl _` into the left list, and the `sum.inr _` into the right list.
  `partition_map (id : ℕ ⊕ ℕ → ℕ ⊕ ℕ) [inl 0, inr 1, inl 2] = ([0,2], [1])`    -/
def partition_map {α : Type u} {β : Type v} {γ : Type w} (f : α → β ⊕ γ) :
    List α → List β × List γ :=
  sorry

/-- `find p l` is the first element of `l` satisfying `p`, or `none` if no such
  element exists. -/
def find {α : Type u} (p : α → Prop) [decidable_pred p] : List α → Option α := sorry

/-- `mfind tac l` returns the first element of `l` on which `tac` succeeds, and
fails otherwise. -/
def mfind {α : Type u} {m : Type u → Type v} [Monad m] [alternative m] (tac : α → m PUnit) :
    List α → m α :=
  mfirst fun (a : α) => tac a $> a

/-- `mbfind' p l` returns the first element `a` of `l` for which `p a` returns
true. `mbfind'` short-circuits, so `p` is not necessarily run on every `a` in
`l`. This is a monadic version of `list.find`. -/
def mbfind' {m : Type u → Type v} [Monad m] {α : Type u} (p : α → m (ulift Bool)) :
    List α → m (Option α) :=
  sorry

/-- A variant of `mbfind'` with more restrictive universe levels. -/
def mbfind {m : Type → Type v} [Monad m] {α : Type} (p : α → m Bool) (xs : List α) : m (Option α) :=
  mbfind' (Functor.map ulift.up ∘ p) xs

/-- `many p as` returns true iff `p` returns true for any element of `l`.
`many` short-circuits, so if `p` returns true for any element of `l`, later
elements are not checked. This is a monadic version of `list.any`. -/
-- Implementing this via `mbfind` would give us less universe polymorphism.

def many {m : Type → Type v} [Monad m] {α : Type u} (p : α → m Bool) : List α → m Bool := sorry

/-- `mall p as` returns true iff `p` returns true for all elements of `l`.
`mall` short-circuits, so if `p` returns false for any element of `l`, later
elements are not checked. This is a monadic version of `list.all`. -/
def mall {m : Type → Type v} [Monad m] {α : Type u} (p : α → m Bool) (as : List α) : m Bool :=
  bnot <$> many (fun (a : α) => bnot <$> p a) as

/-- `mbor xs` runs the actions in `xs`, returning true if any of them returns
true. `mbor` short-circuits, so if an action returns true, later actions are
not run. This is a monadic version of `list.bor`. -/
def mbor {m : Type → Type v} [Monad m] : List (m Bool) → m Bool := many id

/-- `mband xs` runs the actions in `xs`, returning true if all of them return
true. `mband` short-circuits, so if an action returns false, later actions are
not run. This is a monadic version of `list.band`. -/
def mband {m : Type → Type v} [Monad m] : List (m Bool) → m Bool := mall id

/-- Auxiliary definition for `foldl_with_index`. -/
def foldl_with_index_aux {α : Type u} {β : Type v} (f : ℕ → α → β → α) : ℕ → α → List β → α := sorry

/-- Fold a list from left to right as with `foldl`, but the combining function
also receives each element's index. -/
def foldl_with_index {α : Type u} {β : Type v} (f : ℕ → α → β → α) (a : α) (l : List β) : α :=
  foldl_with_index_aux f 0 a l

/-- Auxiliary definition for `foldr_with_index`. -/
def foldr_with_index_aux {α : Type u} {β : Type v} (f : ℕ → α → β → β) : ℕ → β → List α → β := sorry

/-- Fold a list from right to left as with `foldr`, but the combining function
also receives each element's index. -/
def foldr_with_index {α : Type u} {β : Type v} (f : ℕ → α → β → β) (b : β) (l : List α) : β :=
  foldr_with_index_aux f 0 b l

/-- `find_indexes p l` is the list of indexes of elements of `l` that satisfy `p`. -/
def find_indexes {α : Type u} (p : α → Prop) [decidable_pred p] (l : List α) : List ℕ :=
  foldr_with_index (fun (i : ℕ) (a : α) (is : List ℕ) => ite (p a) (i :: is) is) [] l

/-- Returns the elements of `l` that satisfy `p` together with their indexes in
`l`. The returned list is ordered by index. -/
def indexes_values {α : Type u} (p : α → Prop) [decidable_pred p] (l : List α) : List (ℕ × α) :=
  foldr_with_index (fun (i : ℕ) (a : α) (l : List (ℕ × α)) => ite (p a) ((i, a) :: l) l) [] l

/-- `indexes_of a l` is the list of all indexes of `a` in `l`. For example:
```
indexes_of a [a, b, a, a] = [0, 2, 3]
```
-/
def indexes_of {α : Type u} [DecidableEq α] (a : α) : List α → List ℕ := find_indexes (Eq a)

/-- Monadic variant of `foldl_with_index`. -/
def mfoldl_with_index {m : Type v → Type w} [Monad m] {α : Type u_1} {β : Type v}
    (f : ℕ → β → α → m β) (b : β) (as : List α) : m β :=
  foldl_with_index
    (fun (i : ℕ) (ma : m β) (b : α) =>
      do
        let a ← ma
        f i a b)
    (pure b) as

/-- Monadic variant of `foldr_with_index`. -/
def mfoldr_with_index {m : Type v → Type w} [Monad m] {α : Type u_1} {β : Type v}
    (f : ℕ → α → β → m β) (b : β) (as : List α) : m β :=
  foldr_with_index
    (fun (i : ℕ) (a : α) (mb : m β) =>
      do
        let b ← mb
        f i a b)
    (pure b) as

/-- Auxiliary definition for `mmap_with_index`. -/
def mmap_with_index_aux {m : Type v → Type w} [Applicative m] {α : Type u_1} {β : Type v}
    (f : ℕ → α → m β) : ℕ → List α → m (List β) :=
  sorry

/-- Applicative variant of `map_with_index`. -/
def mmap_with_index {m : Type v → Type w} [Applicative m] {α : Type u_1} {β : Type v}
    (f : ℕ → α → m β) (as : List α) : m (List β) :=
  mmap_with_index_aux f 0 as

/-- Auxiliary definition for `mmap_with_index'`. -/
def mmap_with_index'_aux {m : Type v → Type w} [Applicative m] {α : Type u_1}
    (f : ℕ → α → m PUnit) : ℕ → List α → m PUnit :=
  sorry

/-- A variant of `mmap_with_index` specialised to applicative actions which
return `unit`. -/
def mmap_with_index' {m : Type v → Type w} [Applicative m] {α : Type u_1} (f : ℕ → α → m PUnit)
    (as : List α) : m PUnit :=
  mmap_with_index'_aux f 0 as

/-- `lookmap` is a combination of `lookup` and `filter_map`.
  `lookmap f l` will apply `f : α → option α` to each element of the list,
  replacing `a → b` at the first value `a` in the list such that `f a = some b`. -/
def lookmap {α : Type u} (f : α → Option α) : List α → List α := sorry

/-- `countp p l` is the number of elements of `l` that satisfy `p`. -/
def countp {α : Type u} (p : α → Prop) [decidable_pred p] : List α → ℕ := sorry

/-- `count a l` is the number of occurrences of `a` in `l`. -/
def count {α : Type u} [DecidableEq α] (a : α) : List α → ℕ := countp (Eq a)

/-- `is_prefix l₁ l₂`, or `l₁ <+: l₂`, means that `l₁` is a prefix of `l₂`,
  that is, `l₂` has the form `l₁ ++ t` for some `t`. -/
def is_prefix {α : Type u} (l₁ : List α) (l₂ : List α) := ∃ (t : List α), l₁ ++ t = l₂

/-- `is_suffix l₁ l₂`, or `l₁ <:+ l₂`, means that `l₁` is a suffix of `l₂`,
  that is, `l₂` has the form `t ++ l₁` for some `t`. -/
def is_suffix {α : Type u} (l₁ : List α) (l₂ : List α) := ∃ (t : List α), t ++ l₁ = l₂

/-- `is_infix l₁ l₂`, or `l₁ <:+: l₂`, means that `l₁` is a contiguous
  substring of `l₂`, that is, `l₂` has the form `s ++ l₁ ++ t` for some `s, t`. -/
def is_infix {α : Type u} (l₁ : List α) (l₂ : List α) :=
  ∃ (s : List α), ∃ (t : List α), s ++ l₁ ++ t = l₂

infixl:50 " <+: " => Mathlib.list.is_prefix

infixl:50 " <:+ " => Mathlib.list.is_suffix

infixl:50 " <:+: " => Mathlib.list.is_infix

/-- `inits l` is the list of initial segments of `l`.

     inits [1, 2, 3] = [[], [1], [1, 2], [1, 2, 3]] -/
@[simp] def inits {α : Type u} : List α → List (List α) := sorry

/-- `tails l` is the list of terminal segments of `l`.

     tails [1, 2, 3] = [[1, 2, 3], [2, 3], [3], []] -/
@[simp] def tails {α : Type u} : List α → List (List α) := sorry

def sublists'_aux {α : Type u} {β : Type v} :
    List α → (List α → List β) → List (List β) → List (List β) :=
  sorry

/-- `sublists' l` is the list of all (non-contiguous) sublists of `l`.
  It differs from `sublists` only in the order of appearance of the sublists;
  `sublists'` uses the first element of the list as the MSB,
  `sublists` uses the first element of the list as the LSB.

     sublists' [1, 2, 3] = [[], [3], [2], [2, 3], [1], [1, 3], [1, 2], [1, 2, 3]] -/
def sublists' {α : Type u} (l : List α) : List (List α) := sublists'_aux l id []

def sublists_aux {α : Type u} {β : Type v} : List α → (List α → List β → List β) → List β := sorry

/-- `sublists l` is the list of all (non-contiguous) sublists of `l`; cf. `sublists'`
  for a different ordering.

     sublists [1, 2, 3] = [[], [1], [2], [1, 2], [3], [1, 3], [2, 3], [1, 2, 3]] -/
def sublists {α : Type u} (l : List α) : List (List α) := [] :: sublists_aux l List.cons

def sublists_aux₁ {α : Type u} {β : Type v} : List α → (List α → List β) → List β := sorry

/-- `forall₂ R l₁ l₂` means that `l₁` and `l₂` have the same length,
  and whenever `a` is the nth element of `l₁`, and `b` is the nth element of `l₂`,
  then `R a b` is satisfied. -/
inductive forall₂ {α : Type u} {β : Type v} (R : α → β → Prop) : List α → List β → Prop where
| nil : forall₂ R [] []
| cons :
    ∀ {a : α} {b : β} {l₁ : List α} {l₂ : List β},
      R a b → forall₂ R l₁ l₂ → forall₂ R (a :: l₁) (b :: l₂)

/-- Auxiliary definition used to define `transpose`.
  `transpose_aux l L` takes each element of `l` and appends it to the start of
  each element of `L`.

  `transpose_aux [a, b, c] [l₁, l₂, l₃] = [a::l₁, b::l₂, c::l₃]` -/
def transpose_aux {α : Type u} : List α → List (List α) → List (List α) := sorry

/-- transpose of a list of lists, treated as a matrix.

     transpose [[1, 2], [3, 4], [5, 6]] = [[1, 3, 5], [2, 4, 6]] -/
def transpose {α : Type u} : List (List α) → List (List α) := sorry

/-- List of all sections through a list of lists. A section
  of `[L₁, L₂, ..., Lₙ]` is a list whose first element comes from
  `L₁`, whose second element comes from `L₂`, and so on. -/
def sections {α : Type u} : List (List α) → List (List α) := sorry

def permutations_aux2 {α : Type u} {β : Type v} (t : α) (ts : List α) (r : List β) :
    List α → (List α → β) → List α × List β :=
  sorry

def permutations_aux.rec {α : Type u} {C : List α → List α → Sort v} (H0 : (is : List α) → C [] is)
    (H1 : (t : α) → (ts is : List α) → C ts (t :: is) → C is [] → C (t :: ts) is) (l₁ : List α)
    (l₂ : List α) : C l₁ l₂ :=
  sorry

def permutations_aux {α : Type u} : List α → List α → List (List α) := sorry

/-- List of all permutations of `l`.

     permutations [1, 2, 3] =
       [[1, 2, 3], [2, 1, 3], [3, 2, 1],
        [2, 3, 1], [3, 1, 2], [1, 3, 2]] -/
def permutations {α : Type u} (l : List α) : List (List α) := l :: permutations_aux l []

/-- `erasep p l` removes the first element of `l` satisfying the predicate `p`. -/
def erasep {α : Type u} (p : α → Prop) [decidable_pred p] : List α → List α := sorry

/-- `extractp p l` returns a pair of an element `a` of `l` satisfying the predicate
  `p`, and `l`, with `a` removed. If there is no such element `a` it returns `(none, l)`. -/
def extractp {α : Type u} (p : α → Prop) [decidable_pred p] : List α → Option α × List α := sorry

/-- `revzip l` returns a list of pairs of the elements of `l` paired
  with the elements of `l` in reverse order.

`revzip [1,2,3,4,5] = [(1, 5), (2, 4), (3, 3), (4, 2), (5, 1)]`
 -/
def revzip {α : Type u} (l : List α) : List (α × α) := zip l (reverse l)

/-- `product l₁ l₂` is the list of pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂`.

     product [1, 2] [5, 6] = [(1, 5), (1, 6), (2, 5), (2, 6)] -/
def product {α : Type u} {β : Type v} (l₁ : List α) (l₂ : List β) : List (α × β) :=
  list.bind l₁ fun (a : α) => map (Prod.mk a) l₂

/-- `sigma l₁ l₂` is the list of dependent pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂ a`.

     sigma [1, 2] (λ_, [(5 : ℕ), 6]) = [(1, 5), (1, 6), (2, 5), (2, 6)] -/
protected def sigma {α : Type u} {σ : α → Type u_1} (l₁ : List α) (l₂ : (a : α) → List (σ a)) :
    List (sigma fun (a : α) => σ a) :=
  list.bind l₁ fun (a : α) => map (sigma.mk a) (l₂ a)

/-- Auxliary definition used to define `of_fn`.

  `of_fn_aux f m h l` returns the first `m` elements of `of_fn f`
  appended to `l` -/
def of_fn_aux {α : Type u} {n : ℕ} (f : fin n → α) (m : ℕ) : m ≤ n → List α → List α := sorry

/-- `of_fn f` with `f : fin n → α` returns the list whose ith element is `f i`
  `of_fun f = [f 0, f 1, ... , f(n - 1)]` -/
def of_fn {α : Type u} {n : ℕ} (f : fin n → α) : List α := of_fn_aux f n sorry []

/-- `of_fn_nth_val f i` returns `some (f i)` if `i < n` and `none` otherwise. -/
def of_fn_nth_val {α : Type u} {n : ℕ} (f : fin n → α) (i : ℕ) : Option α :=
  dite (i < n) (fun (h : i < n) => some (f { val := i, property := h })) fun (h : ¬i < n) => none

/-- `disjoint l₁ l₂` means that `l₁` and `l₂` have no elements in common. -/
def disjoint {α : Type u} (l₁ : List α) (l₂ : List α) := ∀ {a : α}, a ∈ l₁ → a ∈ l₂ → False

/-- `pairwise R l` means that all the elements with earlier indexes are
  `R`-related to all the elements with later indexes.

     pairwise R [1, 2, 3] ↔ R 1 2 ∧ R 1 3 ∧ R 2 3

  For example if `R = (≠)` then it asserts `l` has no duplicates,
  and if `R = (<)` then it asserts that `l` is (strictly) sorted. -/
inductive pairwise {α : Type u} (R : α → α → Prop) : List α → Prop where
| nil : pairwise R []
| cons : ∀ {a : α} {l : List α}, (∀ (a' : α), a' ∈ l → R a a') → pairwise R l → pairwise R (a :: l)

@[simp] theorem pairwise_cons {α : Type u} {R : α → α → Prop} {a : α} {l : List α} :
    pairwise R (a :: l) ↔ (∀ (a' : α), a' ∈ l → R a a') ∧ pairwise R l :=
  sorry

protected instance decidable_pairwise {α : Type u} {R : α → α → Prop} [DecidableRel R]
    (l : List α) : Decidable (pairwise R l) :=
  List.rec (is_true pairwise.nil)
    (fun (hd : α) (tl : List α) (ih : Decidable (pairwise R tl)) =>
      decidable_of_iff' ((∀ (a' : α), a' ∈ tl → R hd a') ∧ pairwise R tl) pairwise_cons)
    l

/-- `pw_filter R l` is a maximal sublist of `l` which is `pairwise R`.
  `pw_filter (≠)` is the erase duplicates function (cf. `erase_dup`), and `pw_filter (<)` finds
  a maximal increasing subsequence in `l`. For example,

     pw_filter (<) [0, 1, 5, 2, 6, 3, 4] = [0, 1, 2, 3, 4] -/
def pw_filter {α : Type u} (R : α → α → Prop) [DecidableRel R] : List α → List α := sorry

/-- `chain R a l` means that `R` holds between adjacent elements of `a::l`.

     chain R a [b, c, d] ↔ R a b ∧ R b c ∧ R c d -/
inductive chain {α : Type u} (R : α → α → Prop) : α → List α → Prop where
| nil : ∀ {a : α}, chain R a []
| cons : ∀ {a b : α} {l : List α}, R a b → chain R b l → chain R a (b :: l)

/-- `chain' R l` means that `R` holds between adjacent elements of `l`.

     chain' R [a, b, c, d] ↔ R a b ∧ R b c ∧ R c d -/
def chain' {α : Type u} (R : α → α → Prop) : List α → Prop := sorry

@[simp] theorem chain_cons {α : Type u} {R : α → α → Prop} {a : α} {b : α} {l : List α} :
    chain R a (b :: l) ↔ R a b ∧ chain R b l :=
  sorry

protected instance decidable_chain {α : Type u} {R : α → α → Prop} [DecidableRel R] (a : α)
    (l : List α) : Decidable (chain R a l) :=
  List.rec (fun (a : α) => eq.mpr sorry decidable.true)
    (fun (l_hd : α) (l_tl : List α) (l_ih : (a : α) → Decidable (chain R a l_tl)) (a : α) =>
      eq.mpr sorry and.decidable)
    l a

protected instance decidable_chain' {α : Type u} {R : α → α → Prop} [DecidableRel R] (l : List α) :
    Decidable (chain' R l) :=
  list.cases_on l (id decidable.true)
    fun (l_hd : α) (l_tl : List α) => id (list.decidable_chain l_hd l_tl)

/-- `nodup l` means that `l` has no duplicates, that is, any element appears at most
  once in the list. It is defined as `pairwise (≠)`. -/
def nodup {α : Type u} : List α → Prop := pairwise ne

protected instance nodup_decidable {α : Type u} [DecidableEq α] (l : List α) :
    Decidable (nodup l) :=
  list.decidable_pairwise

/-- `erase_dup l` removes duplicates from `l` (taking only the first occurrence).
  Defined as `pw_filter (≠)`.

     erase_dup [1, 0, 2, 2, 1] = [0, 2, 1] -/
def erase_dup {α : Type u} [DecidableEq α] : List α → List α := pw_filter ne

/-- `range' s n` is the list of numbers `[s, s+1, ..., s+n-1]`.
  It is intended mainly for proving properties of `range` and `iota`. -/
@[simp] def range' : ℕ → ℕ → List ℕ := sorry

/-- Drop `none`s from a list, and replace each remaining `some a` with `a`. -/
def reduce_option {α : Type u_1} : List (Option α) → List α := filter_map id

/-- `ilast' x xs` returns the last element of `xs` if `xs` is non-empty;
it returns `x` otherwise -/
@[simp] def ilast' {α : Type u_1} : α → List α → α := sorry

/-- `last' xs` returns the last element of `xs` if `xs` is non-empty;
it returns `none` otherwise -/
@[simp] def last' {α : Type u_1} : List α → Option α := sorry

/-- `rotate l n` rotates the elements of `l` to the left by `n`

     rotate [0, 1, 2, 3, 4, 5] 2 = [2, 3, 4, 5, 0, 1] -/
def rotate {α : Type u} (l : List α) (n : ℕ) : List α := sorry

/-- rotate' is the same as `rotate`, but slower. Used for proofs about `rotate`-/
def rotate' {α : Type u} : List α → ℕ → List α := sorry

/-- Given a decidable predicate `p` and a proof of existence of `a ∈ l` such that `p a`,
choose the first element with this property. This version returns both `a` and proofs
of `a ∈ l` and `p a`. -/
def choose_x {α : Type u} (p : α → Prop) [decidable_pred p] (l : List α)
    (hp : ∃ (a : α), a ∈ l ∧ p a) : Subtype fun (a : α) => a ∈ l ∧ p a :=
  sorry

/-- Given a decidable predicate `p` and a proof of existence of `a ∈ l` such that `p a`,
choose the first element with this property. This version returns `a : α`, and properties
are given by `choose_mem` and `choose_property`. -/
def choose {α : Type u} (p : α → Prop) [decidable_pred p] (l : List α)
    (hp : ∃ (a : α), a ∈ l ∧ p a) : α :=
  ↑(choose_x p l hp)

/-- Filters and maps elements of a list -/
def mmap_filter {m : Type → Type v} [Monad m] {α : Type u_1} {β : Type} (f : α → m (Option β)) :
    List α → m (List β) :=
  sorry

/--
`mmap_upper_triangle f l` calls `f` on all elements in the upper triangular part of `l × l`.
That is, for each `e ∈ l`, it will run `f e e` and then `f e e'`
for each `e'` that appears after `e` in `l`.

Example: suppose `l = [1, 2, 3]`. `mmap_upper_triangle f l` will produce the list
`[f 1 1, f 1 2, f 1 3, f 2 2, f 2 3, f 3 3]`.
-/
def mmap_upper_triangle {m : Type u → Type u_1} [Monad m] {α : Type u} {β : Type u}
    (f : α → α → m β) : List α → m (List β) :=
  sorry

/--
`mmap'_diag f l` calls `f` on all elements in the upper triangular part of `l × l`.
That is, for each `e ∈ l`, it will run `f e e` and then `f e e'`
for each `e'` that appears after `e` in `l`.

Example: suppose `l = [1, 2, 3]`. `mmap'_diag f l` will evaluate, in this order,
`f 1 1`, `f 1 2`, `f 1 3`, `f 2 2`, `f 2 3`, `f 3 3`.
-/
def mmap'_diag {m : Type → Type u_1} [Monad m] {α : Type u_2} (f : α → α → m Unit) :
    List α → m Unit :=
  sorry

protected def traverse {F : Type u → Type v} [Applicative F] {α : Type u_1} {β : Type u}
    (f : α → F β) : List α → F (List β) :=
  sorry

/-- `get_rest l l₁` returns `some l₂` if `l = l₁ ++ l₂`.
  If `l₁` is not a prefix of `l`, returns `none` -/
def get_rest {α : Type u} [DecidableEq α] : List α → List α → Option (List α) := sorry

/--
`list.slice n m xs` removes a slice of length `m` at index `n` in list `xs`.
-/
def slice {α : Type u_1} : ℕ → ℕ → List α → List α := sorry

/--
Left-biased version of `list.map₂`. `map₂_left' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is
applied to `none` for the remaining `aᵢ`. Returns the results of the `f`
applications and the remaining `bs`.

```
map₂_left' prod.mk [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])

map₂_left' prod.mk [1] ['a', 'b'] = ([(1, some 'a')], ['b'])
```
-/
@[simp] def map₂_left' {α : Type u} {β : Type v} {γ : Type w} (f : α → Option β → γ) :
    List α → List β → List γ × List β :=
  sorry

/--
Right-biased version of `list.map₂`. `map₂_right' f as bs` applies `f` to each
pair of elements `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is
applied to `none` for the remaining `bᵢ`. Returns the results of the `f`
applications and the remaining `as`.

```
map₂_right' prod.mk [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])

map₂_right' prod.mk [1, 2] ['a'] = ([(some 1, 'a')], [2])
```
-/
def map₂_right' {α : Type u} {β : Type v} {γ : Type w} (f : Option α → β → γ) (as : List α)
    (bs : List β) : List γ × List α :=
  map₂_left' (flip f) bs as

/--
Left-biased version of `list.zip`. `zip_left' as bs` returns the list of
pairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the
remaining `aᵢ` are paired with `none`. Also returns the remaining `bs`.

```
zip_left' [1, 2] ['a'] = ([(1, some 'a'), (2, none)], [])

zip_left' [1] ['a', 'b'] = ([(1, some 'a')], ['b'])

zip_left' = map₂_left' prod.mk

```
-/
def zip_left' {α : Type u} {β : Type v} : List α → List β → List (α × Option β) × List β :=
  map₂_left' Prod.mk

/--
Right-biased version of `list.zip`. `zip_right' as bs` returns the list of
pairs `(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the
remaining `bᵢ` are paired with `none`. Also returns the remaining `as`.

```
zip_right' [1] ['a', 'b'] = ([(some 1, 'a'), (none, 'b')], [])

zip_right' [1, 2] ['a'] = ([(some 1, 'a')], [2])

zip_right' = map₂_right' prod.mk
```
-/
def zip_right' {α : Type u} {β : Type v} : List α → List β → List (Option α × β) × List α :=
  map₂_right' Prod.mk

/--
Left-biased version of `list.map₂`. `map₂_left f as bs` applies `f` to each pair
`aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, `f` is applied to `none`
for the remaining `aᵢ`.

```
map₂_left prod.mk [1, 2] ['a'] = [(1, some 'a'), (2, none)]

map₂_left prod.mk [1] ['a', 'b'] = [(1, some 'a')]

map₂_left f as bs = (map₂_left' f as bs).fst
```
-/
@[simp] def map₂_left {α : Type u} {β : Type v} {γ : Type w} (f : α → Option β → γ) :
    List α → List β → List γ :=
  sorry

/--
Right-biased version of `list.map₂`. `map₂_right f as bs` applies `f` to each
pair `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, `f` is applied to
`none` for the remaining `bᵢ`.

```
map₂_right prod.mk [1, 2] ['a'] = [(some 1, 'a')]

map₂_right prod.mk [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]

map₂_right f as bs = (map₂_right' f as bs).fst
```
-/
def map₂_right {α : Type u} {β : Type v} {γ : Type w} (f : Option α → β → γ) (as : List α)
    (bs : List β) : List γ :=
  map₂_left (flip f) bs as

/--
Left-biased version of `list.zip`. `zip_left as bs` returns the list of pairs
`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `bs` is shorter than `as`, the
remaining `aᵢ` are paired with `none`.

```
zip_left [1, 2] ['a'] = [(1, some 'a'), (2, none)]

zip_left [1] ['a', 'b'] = [(1, some 'a')]

zip_left = map₂_left prod.mk
```
-/
def zip_left {α : Type u} {β : Type v} : List α → List β → List (α × Option β) := map₂_left Prod.mk

/--
Right-biased version of `list.zip`. `zip_right as bs` returns the list of pairs
`(aᵢ, bᵢ)` for `aᵢ ∈ as` and `bᵢ ∈ bs`. If `as` is shorter than `bs`, the
remaining `bᵢ` are paired with `none`.

```
zip_right [1, 2] ['a'] = [(some 1, 'a')]

zip_right [1] ['a', 'b'] = [(some 1, 'a'), (none, 'b')]

zip_right = map₂_right prod.mk
```
-/
def zip_right {α : Type u} {β : Type v} : List α → List β → List (Option α × β) :=
  map₂_right Prod.mk

/--
If all elements of `xs` are `some xᵢ`, `all_some xs` returns the `xᵢ`. Otherwise
it returns `none`.

```
all_some [some 1, some 2] = some [1, 2]
all_some [some 1, none  ] = none
```
-/
def all_some {α : Type u} : List (Option α) → Option (List α) := sorry

/--
`fill_nones xs ys` replaces the `none`s in `xs` with elements of `ys`. If there
are not enough `ys` to replace all the `none`s, the remaining `none`s are
dropped from `xs`.

```
fill_nones [none, some 1, none, none] [2, 3] = [2, 1, 3]
```
-/
def fill_nones {α : Type u_1} : List (Option α) → List α → List α := sorry

/--
`take_list as ns` extracts successive sublists from `as`. For `ns = n₁ ... nₘ`,
it first takes the `n₁` initial elements from `as`, then the next `n₂` ones,
etc. It returns the sublists of `as` -- one for each `nᵢ` -- and the remaining
elements of `as`. If `as` does not have at least as many elements as the sum of
the `nᵢ`, the corresponding sublists will have less than `nᵢ` elements.

```
take_list ['a', 'b', 'c', 'd', 'e'] [2, 1, 1] = ([['a', 'b'], ['c'], ['d']], ['e'])
take_list ['a', 'b'] [3, 1] = ([['a', 'b'], []], [])
```
-/
def take_list {α : Type u_1} : List α → List ℕ → List (List α) × List α := sorry

/--
`to_rbmap as` is the map that associates each index `i` of `as` with the
corresponding element of `as`.

```
to_rbmap ['a', 'b', 'c'] = rbmap_of [(0, 'a'), (1, 'b'), (2, 'c')]
```
-/
def to_rbmap {α : Type u} : List α → rbmap ℕ α :=
  foldl_with_index (fun (i : ℕ) (mapp : rbmap ℕ α) (a : α) => rbmap.insert mapp i a) (mk_rbmap ℕ α)

end Mathlib


/-
Copyright (c) 2019 Scott Morrison All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import control.equiv_functor
import category_theory.groupoid
import category_theory.whiskering
import category_theory.types

/-!
# The core of a category

The core of a category `C` is the (non-full) subcategory of `C` consisting of all objects,
and all isomorphisms. We construct it as a `groupoid`.

`core.inclusion : core C ⥤ C` gives the faithful inclusion into the original category.

Any functor `F` from a groupoid `G` into `C` factors through `core C`,
but this is not functorial with respect to `F`.
-/

namespace category_theory

universes v₁ v₂ u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].

/-- The core of a category C is the groupoid whose morphisms are all the
isomorphisms of C. -/
@[nolint has_inhabited_instance]
def core (C : Type u₁) := C

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

instance core_category : groupoid.{v₁} (core C) :=
{ hom  := λ X Y : C, X ≅ Y,
  inv  := λ X Y f, iso.symm f,
  id   := λ X, iso.refl X,
  comp := λ X Y Z f g, iso.trans f g }

namespace core
@[simp] lemma id_hom (X : core C) : iso.hom (𝟙 X) = 𝟙 X := rfl
@[simp] lemma comp_hom {X Y Z : core C} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g).hom = f.hom ≫ g.hom :=
rfl

variables (C)

/-- The core of a category is naturally included in the category. -/
def inclusion : core C ⥤ C :=
{ obj := id,
  map := λ X Y f, f.hom }

instance : faithful (inclusion C) := {}

variables {C} {G : Type u₂} [groupoid.{v₂} G]

/-- A functor from a groupoid to a category C factors through the core of C. -/
-- Note that this function is not functorial
-- (consider the two functors from [0] to [1], and the natural transformation between them).
noncomputable
def functor_to_core (F : G ⥤ C) : G ⥤ core C :=
{ obj := λ X, F.obj X,
  map := λ X Y f, ⟨F.map f, F.map (inv f)⟩ }

/--
We can functorially associate to any functor from a groupoid to the core of a category `C`,
a functor from the groupoid to `C`, simply by composing with the embedding `core C ⥤ C`.
-/
def forget_functor_to_core : (G ⥤ core C) ⥤ (G ⥤ C) := (whiskering_right _ _ _).obj (inclusion C)
end core

/--
`of_equiv_functor m` lifts a type-level `equiv_functor`
to a categorical functor `core (Type u₁) ⥤ core (Type u₂)`.
-/
def of_equiv_functor (m : Type u₁ → Type u₂) [equiv_functor m] :
  core (Type u₁) ⥤ core (Type u₂) :=
{ obj       := m,
  map       := λ α β f, (equiv_functor.map_equiv m f.to_equiv).to_iso,
  -- These are not very pretty.
  map_id' := λ α, begin ext, exact (congr_fun (equiv_functor.map_refl _) x), end,
  map_comp' := λ α β γ f g,
  begin
    ext,
    simp only [equiv_functor.map_equiv_apply, equiv.to_iso_hom,
      function.comp_app, core.comp_hom, types_comp],
    erw [iso.to_equiv_comp, equiv_functor.map_trans],
  end, }

end category_theory


/-!
# Introduction

In the context of mathematics, proof is critical. There is little value in stating a
theorem unless there is intent to prove that theorem, or perhaps pose a challenge to the
mathematical community. Often the statement of the theorem is simple, but its proof is
long and complex.

For software development, proof is less critical, though that is not to say it is not
important. The statement of a theorem is a program specification. A proof of the
theorem yields a program that satisfies the specification, or a program separately
constructed can be verified correct with respect to the specification. However,
_routine_ formal verification of programs is not common outside of research activities,
though there are noticeable examples in industry.

What about the specifications themselves? Theorems without proof are of limited
value in mathematics, but specification without proof in software development is
highly valuable. A specification provides a complete and unambiguous statement of
what the software must achieve. Any questions relating to functionality can be
addressed by referring to the specification. Furthermore, while routine proof is
beyond current capability, routine formal specification is a viable goal.

Consider one typical scenario for software development in industry. A collection of
use cases is created capturing the functionality and actor interactions. From this,
the requirements specification is written, consisting of a collection of
individual requirements, presented as __shall__ clauses. For those requirements, a
design is created employing the Unified Modelling Language (UML), which consists of
diagrams (class, state, sequence, etc) supported by natural language descriptive text.
However, a large part of the output of this process is natural language text, with all
the vagueness and ambiguity that entails. Experience shows that, despite significant
effort being expended on using precise language, specifications and designs are open to
interpretation. A designer may misinterpret the intent of a requirement, a software
developer the intent of a requirement or design clause, a tester the intent of a
requirement, etc. The potential for misinterpretation is increased because because the
context is not always clear in informal presentations. A balance has to be
maintained with requirements to, on the one hand, be concise and to the point, and on
the other hand, provide enough contextual information to ensure correct interpretation.

Formal specifications are precise and unambiguous due the the semantics of the
underlying formal language. Mathematical notation, which has evolved over hundreds of
years, allows concise expression of specifications. The formal notation further ensures
context is unambiguous (i.e. everything on which the specification depends is explicit).
Dependently typed languages are particularly suited to program specification because of
the tight integration between specification language, programming language, and proof
framework. In the case of Lean, they are one and the same language. Furthermore, the
concept of dependent type provides a richness of expression not available in
non-dependent approaches.

# Lean As A Specification Language

This tutorial is not intended to be a comprehensive description of the Lean language
and its logic. Here we provide an overview of the more salient parts to allow understanding
of later sections. Full details can be found in the [Lean 4 Manual](https://leanprover.github.io/lean4/doc/).
The most relevant content is:
* [Theorem Proving in Lean](https://leanprover.github.io/theorem_proving_in_lean4/title_page.html)
for the logic and proof;
* [Functional Programming in Lean](https://leanprover.github.io/lean4/doc/fplean.html)
for the programming language.

## Lean Logic

The Lean logic includes the usual propositional connectives and quantifiers:

| Connective | Meaning                    |
| ---------- | -------------------------- |
| P ∧ Q      | Conjunction                |
| P ∨ Q      | Disjunction                |
| P → Q      | Implication                |
| P ↔ Q      | Logical Equivalence        |
| ¬ P        | Negation                   |
| ∀x, P x    | Universal Quantification   |
| ∃x, P x    | Existential Quantification |
| True       | Always true proposition    |
| False      | Never true proposition     |

## Lean Types

Some of the types provided by Lean are:

| Connective  | Meaning            |
| ----------- | ------------------- |
| T × U       | Cartesian Product   |
| T ⊕ U       | Disjoint Union      |
| T → U       | Function Type       |
| Nat         | Natural Numbers     |
| String      | Character Sequences |
| List T      | Finite Sequences of T's |
| (a:A) → B a | Dependent Function  |
| (a:A) × B a | Dependent Product   |

Most of these types are common with many other languages. The last two are
characteristic of dependent type theory. The function and Cartesian product types
are the degenerate cases of the dependent function and product types (respectively)
in which there is no dependence between the type arguments.

## Types, Propositions and Specifications

The propositional connectives and quantifiers provided by Lean are commonly understood,
as are the non-dependent types. The dependent function and product types are less
familiar and give dependent type theory (and hence Lean) its unique flavour.

Consider the specification of a function that doubles a number. Its property
is captured by:
-/
def DoubleProp := ∀n : Nat, ∃m : Nat, m = 2 * n

/-
A simple specification, but not quite what we want. In Lean propositions have
no computational content, they are either provable or not provable, so we need
to define a function separately and prove it satisfies the proposition.

Types, on the other hand, have data and computational content. If we had a type
that captured the same meaning as the proposition, then an element of the type
would be a function satisfying the proposition. It is the expressive power of
dependent type theory that allows us to construct types of this nature. Given the
dependent function corresponds to universal quantification, and dependent product
corresponds to existential quantification, we might try something like:
-/
def Double₁ := (n : Nat) → (m : Nat) × sorry -- m = 2 * n

/-
Here we have a function that takes `n : Nat` as argument, and returns a pair.
The first element of the pair is a number `m : Nat`, and the second element is
something that captures the desired relationship `m = 2 * n`. The problem
we have here is the second argument of a product is a type, but the property
we want to express is a proposition (which in Lean is not the same as a type).

We need a hybrid that captures the data aspect of the dependent product, and the
propositional aspect of the existential quantifier. Lean has such an entity: the _subtype_.
A subtype is of the form `{ a : A // P a }` where `A` is a type and `P a` is a
proposition. The elements of the subtype are those elements `a` of type `A` such that
the proposition `P a` holds. The specification becomes:
-/
def Double₂ := (n : Nat) → { m : Nat // m = 2 * n }

/-
`Double₂` is a type; the type of functions that take a natural number as argument
and double the argument.

When specifying functions we can move universally quantified variables and function arguments
to the left of the `:=`:
-/
def Double₃ (n : Nat) := { m : Nat // m = 2 * n }

/-
This latter approach will in general be used throughout the tutorial.

Strictly, an element of `{ a : A // P a }` is not simply an element of `A`, it is
a pair whose first component is an element `a` of type `A`, and whose second
component is evidence of `P a`. If we were to define a function that meets this
specification it would look like:
-/
def double (n : Nat) : { m : Nat // m = 2 * n } :=
  {val := 2 * n, property := rfl}

/-
The result is the number (`val`) and evidence the number is twice the argument
(`property`, where the evidence here is simply shown by reflexivity). In some
situations Lean can coerce, automatically, an element of the subtype to the embedded
data value. When this is not possible, the value must be referenced explicitly.

We can now check that `double` does indeed implement the specification `Double₃`.
That is `double n` is of type `Double₃ n` for any `n`:
-/
variable (n : Nat)
#check (double n : Double₃ n)

/-
We also have:
-/
#check (double : Double₂)

/-
A program that corresponds directly to a specification includes not just the computational
component, but the evidence that it meets the specified constraints. With large specifications
that have multiple, nested subtypes, this evidence becomes rather large. From a purely programming
perspective we are only interested in the computational content. In the case of `double` the
function we really want is:
-/
def double₁ (n : Nat) : Nat :=
  2 * n

/-
The non-computational content is not problematic. It does not intrude when constructing
specifications, and it is essential for deriving/verifying programs. Removal of the
non-computational content can be automated at the compilation stage. In fact, the evaluation
-/
#eval double 4
/-
outputs the value `8`, not the complete subtype structure.

Notes:

- While the subtype is used extensively in program specification, the dependent product type turns out
to be of less use than might be expected.

- This tutorial has been developed as a Lean script that can be
loaded into a Lean IDE such as Visual Studio Code. Lean requires that any value
be defined before it is used, which imposes a strict constraint on how a
specification is presented. Often it is preferable to present in a top-down manner,
starting with higher level concepts that are iteratively broken down into their
components. The Lean definition-before-use requirement means that specifications are
presented in a bottom-up manner.

- The specifications in this tutorial use definitions from core Lean and the Lean 4
standard library ([std4](https://github.com/leanprover/std4)).

- Standard Lean naming convention is adopted. Type and proposition names are camel case
with initial upper case. Function names are camel case with initial lower case.
-/


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

/-
Main procedure for linear integer arithmetic.
-/

import tactic.omega.prove_unsats
import tactic.omega.int.dnf

open tactic

namespace omega
namespace int

open_locale omega.int

run_cmd mk_simp_attr `sugar
attribute [sugar]
  ne not_le not_lt
  int.lt_iff_add_one_le
  or_false false_or
  and_true true_and
  ge gt mul_add add_mul
  one_mul mul_one
  mul_comm sub_eq_add_neg
  imp_iff_not_or
  iff_iff_not_or_and_or_not

meta def desugar := `[try {simp only with sugar}]

lemma univ_close_of_unsat_clausify (m : nat) (p : preform) :
  clauses.unsat (dnf (¬* p)) → univ_close p (λ x, 0) m | h1 :=
begin
  apply univ_close_of_valid,
  apply valid_of_unsat_not,
  apply unsat_of_clauses_unsat,
  exact h1
end

/-- Given a (p : preform), return the expr of a (t : univ_close m p) -/
meta def prove_univ_close (m : nat) (p : preform) : tactic expr :=
do x ← prove_unsats (dnf (¬*p)),
   return `(univ_close_of_unsat_clausify %%`(m) %%`(p) %%x)

/-- Reification to imtermediate shadow syntax that retains exprs -/
meta def to_exprterm : expr → tactic exprterm
| `(- %%x) := --return (exprterm.exp (-1 : int) x)
  ( do z ← eval_expr' int x,
       return (exprterm.cst (-z : int)) ) <|>
  ( return $ exprterm.exp (-1 : int) x )
| `(%%mx * %%zx) :=
  do z ← eval_expr' int zx,
     return (exprterm.exp z mx)
| `(%%t1x + %%t2x) :=
  do t1 ← to_exprterm t1x,
     t2 ← to_exprterm t2x,
     return (exprterm.add t1 t2)
| x :=
  ( do z ← eval_expr' int x,
       return (exprterm.cst z) ) <|>
  ( return $ exprterm.exp 1 x )

/-- Reification to imtermediate shadow syntax that retains exprs -/
meta def to_exprform : expr → tactic exprform
| `(%%tx1 = %%tx2) :=
  do t1 ← to_exprterm tx1,
     t2 ← to_exprterm tx2,
     return (exprform.eq t1 t2)
| `(%%tx1 ≤ %%tx2) :=
  do t1 ← to_exprterm tx1,
     t2 ← to_exprterm tx2,
     return (exprform.le t1 t2)
| `(¬ %%px) := do p ← to_exprform px, return (exprform.not p)
| `(%%px ∨ %%qx) :=
  do p ← to_exprform px,
     q ← to_exprform qx,
     return (exprform.or p q)
| `(%%px ∧ %%qx) :=
  do p ← to_exprform px,
     q ← to_exprform qx,
     return (exprform.and p q)

| `(_ → %%px) := to_exprform px
| x := trace "Cannot reify expr : " >> trace x >> failed

/-- List of all unreified exprs -/
meta def exprterm.exprs : exprterm → list expr
| (exprterm.cst _)   := []
| (exprterm.exp _ x) := [x]
| (exprterm.add t s) := list.union t.exprs s.exprs

/-- List of all unreified exprs -/
meta def exprform.exprs : exprform → list expr
| (exprform.eq t s)  := list.union t.exprs s.exprs
| (exprform.le t s)  := list.union t.exprs s.exprs
| (exprform.not p)   := p.exprs
| (exprform.or p q)  := list.union p.exprs q.exprs
| (exprform.and p q) := list.union p.exprs q.exprs

/-- Reification to an intermediate shadow syntax which eliminates exprs,
    but still includes non-canonical terms -/
meta def exprterm.to_preterm (xs : list expr) : exprterm → tactic preterm
| (exprterm.cst k)   := return & k
| (exprterm.exp k x) :=
  let m := xs.index_of x in
  if m < xs.length
  then return (k ** m)
  else failed
| (exprterm.add xa xb) :=
  do a ← xa.to_preterm,
     b ← xb.to_preterm,
     return (a +* b)

/-- Reification to an intermediate shadow syntax which eliminates exprs,
    but still includes non-canonical terms -/
meta def exprform.to_preform (xs : list expr) : exprform → tactic preform
| (exprform.eq xa xb)  :=
   do a ← xa.to_preterm xs,
      b ← xb.to_preterm xs,
      return (a =* b)
| (exprform.le xa xb)  :=
   do a ← xa.to_preterm xs,
      b ← xb.to_preterm xs,
      return (a ≤* b)
| (exprform.not xp)    :=
  do p ← xp.to_preform,
     return ¬* p
| (exprform.or xp xq)  :=
  do p ← xp.to_preform,
     q ← xq.to_preform,
     return (p ∨* q)
| (exprform.and xp xq) :=
  do p ← xp.to_preform,
     q ← xq.to_preform,
     return (p ∧* q)

/-- Reification to an intermediate shadow syntax which eliminates exprs,
    but still includes non-canonical terms. -/
meta def to_preform (x : expr) : tactic (preform × nat) :=
do xf ← to_exprform x,
   let xs := xf.exprs,
   f ← xf.to_preform xs,
   return (f, xs.length)

/-- Return expr of proof of current LIA goal -/
meta def prove : tactic expr :=
do (p,m) ← target >>= to_preform,
   trace_if_enabled `omega p,
   prove_univ_close m p

/-- Succeed iff argument is the expr of ℤ -/
meta def eq_int (x : expr) : tactic unit :=
if x = `(int) then skip else failed

/-- Check whether argument is expr of a well-formed formula of LIA-/
meta def wff : expr → tactic unit
| `(¬ %%px)      := wff px
| `(%%px ∨ %%qx) := wff px >> wff qx
| `(%%px ∧ %%qx) := wff px >> wff qx
| `(%%px ↔ %%qx) := wff px >> wff qx
| `(%%(expr.pi _ _ px qx)) :=
  monad.cond
     (if expr.has_var px then return tt else is_prop px)
     (wff px >> wff qx)
     (eq_int px >> wff qx)
| `(@has_lt.lt %%dx %%h _ _) := eq_int dx
| `(@has_le.le %%dx %%h _ _) := eq_int dx
| `(@eq %%dx _ _)            := eq_int dx
| `(@ge %%dx %%h _ _)        := eq_int dx
| `(@gt %%dx %%h _ _)        := eq_int dx
| `(@ne %%dx _ _)            := eq_int dx
| `(true)                    := skip
| `(false)                   := skip
| _                          := failed

/-- Succeed iff argument is expr of term whose type is wff -/
meta def wfx (x : expr) : tactic unit :=
infer_type x >>= wff

/-- Intro all universal quantifiers over ℤ -/
meta def intro_ints_core : tactic unit :=
do x ← target,
   match x with
   | (expr.pi _ _ `(int) _) := intro_fresh >> intro_ints_core
   | _                      := skip
   end

meta def intro_ints : tactic unit :=
do (expr.pi _ _ `(int) _) ← target,
   intro_ints_core

/-- If the goal has universal quantifiers over integers, introduce all of them.
Otherwise, revert all hypotheses that are formulas of linear integer arithmetic. -/
meta def preprocess : tactic unit :=
intro_ints <|> (revert_cond_all wfx >> desugar)

end int
end omega

open omega.int

/-- The core omega tactic for integers. -/
meta def omega_int (is_manual : bool) : tactic unit :=
desugar ; (if is_manual then skip else preprocess) ; prove >>= apply >> skip


import tactic

example {α : Type*} (r : α → α → Prop) : ¬ ∃ x, ∀ z, r z x ↔ ¬ r x x :=
begin
  rintros ⟨x, hx⟩,
  specialize hx x,
  simpa using hx
end


import prf

namespace first_order

section dnf

variables (A : Type)
variables {L : language} (Γ : list (formula L)) {p q : formula L} [has_coe A (formula L)]

-- TODO: Use this
def equiv (α : Type) [has_coe α (formula L)]: Prop :=
  ∀ φ : formula L, ∃ ψ : α, (A∣Γ ⊢ φ) ↔ (A∣Γ ⊢ ψ)

-- def equiv_dcl := equiv dcl

-- def equiv_dnf := equiv dnf

def equiv_dcl (φ : formula L) : Prop := ∃ ψ : dcl L, (A∣[] ⊢ φ) ↔ (A∣[] ⊢ (ψ : formula L))

def equiv_dnf (φ : formula L) : Prop := ∃ ψ : dnf L, (A∣[] ⊢ φ) ↔ (A∣[] ⊢ (ψ : formula L))

lemma Eq_equiv_dcl : ((A∣[] ⊢ p) ↔ (A∣[] ⊢ q)) → (equiv_dcl A p → equiv_dcl A q) := begin
   intros h₁ h₂,
   rcases h₂ with ⟨φ₃, h₃⟩,
   existsi φ₃,
   split,
   intro h₄,
   apply h₃.mp (h₁.mpr h₄),
   intro h₄,
   apply h₁.mp (h₃.mpr h₄),
end

lemma Eq_equiv_dnf : ((A∣[] ⊢ p) ↔ (A∣[] ⊢ q)) → (equiv_dnf A p → equiv_dnf A q) := begin
   intros h₁ h₂,
   rcases h₂ with ⟨φ₃, h₃⟩,
   existsi φ₃,
   split,
   intro h₄,
   apply h₃.mp (h₁.mpr h₄),
   intro h₄,
   apply h₁.mp (h₃.mpr h₄),
end

/- The negation of a literal (as a literal) is equivalent to the negation of the literal (as a formula) -/
lemma neg_lit_equiv_lit : ∀ φ : lit L, (A∣Γ ⊢ ∼↑φ) ↔ (A∣Γ ⊢ neg_lit _ φ) := begin
  intro φ,
  cases φ,
  refl,
  simp,
  split,
  intro h,
  apply R_ Double_negation_elim,
  assumption,
  intro h,
  apply R_ Double_negation_intro,
  assumption,
end

lemma dcl_and_equiv_dcl : ∀ φ₁ φ₂ : dcl L, equiv_dcl A ((φ₁ : formula L) and φ₂) := begin
  intros φ₁ φ₂,
  induction φ₁, induction φ₂,
  { existsi (cl.c φ₁ φ₂ : dcl L), refl },
  { rcases φ₂_ih_ᾰ with ⟨φ₂₁, h₂₁⟩, rcases φ₂_ih_ᾰ_1 with ⟨φ₂₂, h₂₂⟩,
    apply Eq_equiv_dcl A ⟨R_ DistributionAndOrOutLeft, R_ DistributionAndOrInLeft⟩,
    apply Eq_equiv_dcl A (R_Eq_Or_ ⟨h₂₁.mpr, h₂₁.mp⟩ ⟨h₂₂.mpr, h₂₂.mp⟩),
    existsi dcl.d φ₂₁ φ₂₂, refl,
  },
  { rcases φ₁_ih_ᾰ with ⟨φ₁₁, h₁₁⟩, rcases φ₁_ih_ᾰ_1 with ⟨φ₁₂, h₁₂⟩,
    apply Eq_equiv_dcl A ⟨R_ DistributionAndOrOutRight, R_ DistributionAndOrInRight⟩,
    apply Eq_equiv_dcl A (R_Eq_Or_ ⟨h₁₁.mpr, h₁₁.mp⟩ ⟨h₁₂.mpr, h₁₂.mp⟩),
    existsi dcl.d φ₁₁ φ₁₂, refl,
  }
end

lemma dcl_not_equiv_dcl : ∀ φ : dcl L, equiv_dcl A (∼φ : formula L) := begin
  intro φ,
  induction φ, induction φ,
  { existsi (neg_lit L φ : dcl L), apply neg_lit_equiv_lit },
  { rcases φ_ih_ᾰ with ⟨φ₁, h₁⟩, rcases φ_ih_ᾰ_1 with ⟨φ₂, h₂⟩,
    existsi dcl.d φ₁ φ₂, split,
    intro h,
    apply R_Or_ h₁.mp h₂.mp,
    apply R_ DeMorganNotAnd, apply h,
    intro h,
    apply R_ DeMorganOr,
    apply R_Or_ h₁.mpr h₂.mpr,
    apply h,
  },
  { rcases φ_ih_ᾰ with ⟨φ₁, h₁⟩, rcases φ_ih_ᾰ_1 with ⟨φ₂, h₂⟩,
    apply Eq_equiv_dcl A ⟨R_ DeMorganAnd, R_ DeMorganNotOr⟩,
    apply Eq_equiv_dcl A (R_Eq_And_ ⟨h₁.mpr, h₁.mp⟩ ⟨h₂.mpr, h₂.mp⟩),
    apply dcl_and_equiv_dcl
  }
end

lemma dcl_or_equiv_dcl : ∀ φ₁ φ₂ : dcl L, equiv_dcl A ((φ₁ : formula L) or φ₂) := begin
  intros φ₁ φ₂,
  { existsi (dcl.d φ₁ φ₂ : dcl L), refl },
end

lemma qf_equiv_dcl : ∀ φ : qf L, equiv_dcl A (φ : formula L) := begin
  intro φ,
  induction φ,
  { existsi (@atom.f L : dcl L), refl, },
  { existsi (@atom.e L φ_ᾰ φ_ᾰ_1 : dcl L), refl },
  { existsi (@atom.r L φ_n φ_ᾰ φ_ᾰ_1 : dcl L), refl },
  { rcases φ_ih with ⟨φ, h⟩,
    apply Eq_equiv_dcl  A (R_Eq_Not_ ⟨h.mpr, h.mp⟩),
    apply dcl_not_equiv_dcl, },
  { rcases φ_ih_ᾰ with ⟨φ₁, h₁⟩, rcases φ_ih_ᾰ_1 with ⟨φ₂, h₂⟩,
    apply Eq_equiv_dcl A (R_Eq_Or_ ⟨h₁.mpr, h₁.mp⟩ ⟨h₂.mpr, h₂.mp⟩),
    apply dcl_or_equiv_dcl },
end

lemma equiv_dcl_equiv_dnf : ∀ φ : formula L, equiv_dcl A φ →  equiv_dnf A φ := begin
  intros φ₁ h₁,
  rcases h₁ with ⟨φ₂, h₂⟩,
  existsi (dnf.dcl φ₂),
  apply h₂,
end

lemma dnf_not_equiv_dnf : ∀ φ : dnf L, equiv_dnf A ∼(φ : formula L) := begin
  intro φ,
  induction φ,
  { apply equiv_dcl_equiv_dnf, apply dcl_not_equiv_dcl },
  { apply Eq_equiv_dnf A ⟨R_ ExNot, R_ NotAll⟩,
    rcases φ_ih with ⟨φ, h⟩,
    apply Eq_equiv_dnf A (R_Eq_Ex_ ⟨h.mpr, h.mp⟩), simp,
    existsi dnf.ex φ_ᾰ φ, refl
  },
  { apply Eq_equiv_dnf A ⟨R_ AllNot, R_ NotEx⟩,
    rcases φ_ih with ⟨φ, h⟩,
    apply Eq_equiv_dnf A (R_Eq_All_ ⟨h.mpr, h.mp⟩),
    existsi dnf.al φ_ᾰ φ, refl
  }
end

lemma dnf_or_equiv_dnf : ∀ φ₁ φ₂ : dnf L, equiv_dnf A ((φ₁ : formula L) or φ₂) := begin
  intros φ₁ φ₂,
  induction φ₁, induction φ₂,
  { apply equiv_dcl_equiv_dnf, apply dcl_or_equiv_dcl },
  repeat { sorry },
end

lemma dnf_all_equiv_dnf : ∀ n : ℕ, ∀ φ : dnf L, equiv_dnf A (formula.all n (φ : formula L)) := begin
  intros n φ,
  induction φ,
  { existsi (dnf.al n (dnf.dcl φ)), refl },
  repeat { sorry },
end

/- All formulas are logical equivalent to a formula in dnf -/
theorem for_all_equiv_dnf : ∀ φ : formula L, equiv_dnf A φ := begin
  intro φ,
  induction φ,
  { existsi (@atom.f L : dnf L), refl, },
  { existsi (@atom.e L φ_ᾰ φ_ᾰ_1 : dnf L), refl },
  { existsi (@atom.r L φ_n φ_ᾰ φ_ᾰ_1 : dnf L), refl },
  { rcases φ_ih with ⟨φ, h⟩,
    apply Eq_equiv_dnf A (R_Eq_Not_ ⟨h.mpr, h.mp⟩),
    apply dnf_not_equiv_dnf, },
  { rcases φ_ih_ᾰ with ⟨φ₁, h₁⟩, rcases φ_ih_ᾰ_1 with ⟨φ₂, h₂⟩,
    apply Eq_equiv_dnf A (R_Eq_Or_ ⟨h₁.mpr, h₁.mp⟩ ⟨h₂.mpr, h₂.mp⟩),
    apply dnf_or_equiv_dnf },
  { rcases φ_ih with ⟨φ, h⟩,
    apply Eq_equiv_dnf A (R_Eq_All_ ⟨h.mpr, h.mp⟩),
    apply dnf_all_equiv_dnf }
end

end dnf

end first_order


example (A B C D E F G H I J K L : Prop)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L :=
begin
    cc,
end


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.monoidal.types
import category_theory.monoidal.center

/-!
# Enriched categories

We set up the basic theory of `V`-enriched categories,
for `V` an arbitrary monoidal category.

We do not assume here that `V` is a concrete category,
so there does not need to be a "honest" underlying category!

Use `X ⟶[V] Y` to obtain the `V` object of morphisms from `X` to `Y`.

This file contains the definitions of `V`-enriched categories and
`V`-functors.

We don't yet define the `V`-object of natural transformations
between a pair of `V`-functors (this requires limits in `V`),
but we do provide a presheaf isomorphic to the Yoneda embedding of this object.

We verify that when `V = Type v`, all these notion reduce to the usual ones.
-/

universes w v u₁ u₂ u₃

noncomputable theory

namespace category_theory

open opposite
open monoidal_category

variables (V : Type v) [category.{w} V] [monoidal_category V]

/--
A `V`-category is a category enriched in a monoidal category `V`.

Note that we do not assume that `V` is a concrete category,
so there may not be an "honest" underlying category at all!
-/
class enriched_category (C : Type u₁) :=
(hom : C → C → V)
(notation X ` ⟶[] ` Y:10 := hom X Y)
(id : Π X, 𝟙_ V ⟶ (X ⟶[] X))
(comp : Π X Y Z, (X ⟶[] Y) ⊗ (Y ⟶[] Z) ⟶ (X ⟶[] Z))
(id_comp : Π X Y, (λ_ (X ⟶[] Y)).inv ≫ (id X ⊗ 𝟙 _) ≫ comp X X Y = 𝟙 _ . obviously)
(comp_id : Π X Y, (ρ_ (X ⟶[] Y)).inv ≫ (𝟙 _ ⊗ id Y) ≫ comp X Y Y = 𝟙 _ . obviously)
(assoc :
  Π W X Y Z, (α_ _ _ _).inv ≫ (comp W X Y ⊗ 𝟙 _) ≫ comp W Y Z = (𝟙 _ ⊗ comp X Y Z) ≫ comp W X Z
  . obviously)

notation X ` ⟶[`V`] ` Y:10 := (enriched_category.hom X Y : V)

variables (V) {C : Type u₁} [enriched_category V C]

/--
The `𝟙_ V`-shaped generalized element giving the identity in a `V`-enriched category.
-/
def e_id (X : C) : 𝟙_ V ⟶ (X ⟶[V] X) := enriched_category.id X
/--
The composition `V`-morphism for a `V`-enriched category.
-/
def e_comp (X Y Z : C) : (X ⟶[V] Y) ⊗ (Y ⟶[V] Z) ⟶ (X ⟶[V] Z) := enriched_category.comp X Y Z

-- We don't just use `restate_axiom` here; that would leave `V` as an implicit argument.
@[simp, reassoc]
lemma e_id_comp (X Y : C) :
  (λ_ (X ⟶[V] Y)).inv ≫ (e_id V X ⊗ 𝟙 _) ≫ e_comp V X X Y = 𝟙 (X ⟶[V] Y) :=
enriched_category.id_comp X Y

@[simp, reassoc]
lemma e_comp_id (X Y : C) :
  (ρ_ (X ⟶[V] Y)).inv ≫ (𝟙 _ ⊗ e_id V Y) ≫ e_comp V X Y Y = 𝟙 (X ⟶[V] Y) :=
enriched_category.comp_id X Y

@[simp, reassoc]
lemma e_assoc (W X Y Z : C) :
  (α_ _ _ _).inv ≫ (e_comp V W X Y ⊗ 𝟙 _) ≫ e_comp V W Y Z =
    (𝟙 _ ⊗ e_comp V X Y Z) ≫ e_comp V W X Z :=
enriched_category.assoc W X Y Z

section
variables {V} {W : Type v} [category.{w} W] [monoidal_category W]

/--
A type synonym for `C`, which should come equipped with a `V`-enriched category structure.
In a moment we will equip this with the `W`-enriched category structure
obtained by applying the functor `F : lax_monoidal_functor V W` to each hom object.
-/
@[nolint has_inhabited_instance unused_arguments]
def transport_enrichment (F : lax_monoidal_functor V W) (C : Type u₁) := C

instance (F : lax_monoidal_functor V W) :
  enriched_category W (transport_enrichment F C) :=
{ hom := λ (X Y : C), F.obj (X ⟶[V] Y),
  id := λ (X : C), F.ε ≫ F.map (e_id V X),
  comp := λ (X Y Z : C), F.μ _ _ ≫ F.map (e_comp V X Y Z),
  id_comp := λ X Y, begin
    rw [comp_tensor_id, category.assoc,
      ←F.to_functor.map_id, F.μ_natural_assoc, F.to_functor.map_id, F.left_unitality_inv_assoc,
      ←F.to_functor.map_comp, ←F.to_functor.map_comp, e_id_comp, F.to_functor.map_id],
  end,
  comp_id := λ X Y, begin
    rw [id_tensor_comp, category.assoc,
      ←F.to_functor.map_id, F.μ_natural_assoc, F.to_functor.map_id, F.right_unitality_inv_assoc,
      ←F.to_functor.map_comp, ←F.to_functor.map_comp, e_comp_id, F.to_functor.map_id],
  end,
  assoc := λ P Q R S, begin
    rw [comp_tensor_id, category.assoc, ←F.to_functor.map_id, F.μ_natural_assoc,
      F.to_functor.map_id, ←F.associativity_inv_assoc, ←F.to_functor.map_comp,
      ←F.to_functor.map_comp, e_assoc, id_tensor_comp, category.assoc, ←F.to_functor.map_id,
      F.μ_natural_assoc, F.to_functor.map_comp],
  end, }

end

/--
Construct an honest category from a `Type v`-enriched category.
-/
def category_of_enriched_category_Type (C : Type u₁) [𝒞 : enriched_category (Type v) C] :
  category.{v} C :=
{ hom := 𝒞.hom,
  id := λ X, e_id (Type v) X punit.star,
  comp := λ X Y Z f g, e_comp (Type v) X Y Z ⟨f, g⟩,
  id_comp' := λ X Y f, congr_fun (e_id_comp (Type v) X Y) f,
  comp_id' := λ X Y f, congr_fun (e_comp_id (Type v) X Y) f,
  assoc' := λ W X Y Z f g h, (congr_fun (e_assoc (Type v) W X Y Z) ⟨f, g, h⟩ : _), }

/--
Construct a `Type v`-enriched category from an honest category.
-/
def enriched_category_Type_of_category (C : Type u₁) [𝒞 : category.{v} C] :
  enriched_category (Type v) C :=
{ hom := 𝒞.hom,
  id := λ X p, 𝟙 X,
  comp := λ X Y Z p, p.1 ≫ p.2,
  id_comp := λ X Y, by { ext, simp, },
  comp_id := λ X Y, by { ext, simp, },
  assoc := λ W X Y Z, by { ext ⟨f, g, h⟩, simp, }, }

/--
We verify that an enriched category in `Type u` is just the same thing as an honest category.
-/
def enriched_category_Type_equiv_category (C : Type u₁) :
  (enriched_category (Type v) C) ≃ category.{v} C :=
{ to_fun := λ 𝒞, by exactI category_of_enriched_category_Type C,
  inv_fun := λ 𝒞, by exactI enriched_category_Type_of_category C,
  left_inv := λ 𝒞, begin
    cases 𝒞,
    dsimp [enriched_category_Type_of_category],
    congr,
    { ext X ⟨⟩, refl, },
    { ext X Y Z ⟨f, g⟩, refl, }
  end,
  right_inv := λ 𝒞, by { rcases 𝒞 with ⟨⟨⟨⟩⟩⟩, dsimp, congr, }, }.

section
variables {W : Type (v+1)} [category.{v} W] [monoidal_category W] [enriched_category W C]

/-- A type synonym for `C`, which should come equipped with a `V`-enriched category structure.
In a moment we will equip this with the (honest) category structure
so that `X ⟶ Y` is `(𝟙_ W) ⟶ (X ⟶[W] Y)`.

We obtain this category by
transporting the enrichment in `V` along the lax monoidal functor `coyoneda_tensor_unit`,
then using the equivalence of `Type`-enriched categories with honest categories.

This is sometimes called the "underlying" category of an enriched category,
although some care is needed as the functor `coyoneda_tensor_unit`,
which always exists, does not necessarily coincide with
"the forgetful functor" from `V` to `Type`, if such exists.
When `V` is any of `Type`, `Top`, `AddCommGroup`, or `Module R`,
`coyoneda_tensor_unit` is just the usual forgetful functor, however.
For `V = Algebra R`, the usual forgetful functor is coyoneda of `polynomial R`, not of `R`.
(Perhaps we should have a typeclass for this situation: `concrete_monoidal`?)
-/
@[nolint has_inhabited_instance unused_arguments]
def forget_enrichment
  (W : Type (v+1)) [category.{v} W] [monoidal_category W] (C : Type u₁) [enriched_category W C] :=
C

variables (W)

/-- Typecheck an object of `C` as an object of `forget_enrichment W C`. -/
def forget_enrichment.of (X : C) : forget_enrichment W C := X

/-- Typecheck an object of `forget_enrichment W C` as an object of `C`. -/
def forget_enrichment.to (X : forget_enrichment W C) : C := X

@[simp] lemma forget_enrichment.to_of (X : C) :
  forget_enrichment.to W (forget_enrichment.of W X) = X := rfl
@[simp] lemma forget_enrichment.of_to (X : forget_enrichment W C) :
  forget_enrichment.of W (forget_enrichment.to W X) = X := rfl

instance category_forget_enrichment : category (forget_enrichment W C) :=
begin
  let I : enriched_category (Type v) (transport_enrichment (coyoneda_tensor_unit W) C) :=
    infer_instance,
  exact enriched_category_Type_equiv_category C I,
end

/--
We verify that the morphism types in `forget_enrichment W C` are `(𝟙_ W) ⟶ (X ⟶[W] Y)`.
-/
example (X Y : forget_enrichment W C) :
  (X ⟶ Y) = ((𝟙_ W) ⟶ (forget_enrichment.to W X ⟶[W] forget_enrichment.to W Y)) :=
rfl

/-- Typecheck a `(𝟙_ W)`-shaped `W`-morphism as a morphism in `forget_enrichment W C`. -/
def forget_enrichment.hom_of {X Y : C} (f : (𝟙_ W) ⟶ (X ⟶[W] Y)) :
  forget_enrichment.of W X ⟶ forget_enrichment.of W Y :=
f

/-- Typecheck a morphism in `forget_enrichment W C` as a `(𝟙_ W)`-shaped `W`-morphism. -/
def forget_enrichment.hom_to {X Y : forget_enrichment W C} (f : X ⟶ Y) :
  (𝟙_ W) ⟶ (forget_enrichment.to W X ⟶[W] forget_enrichment.to W Y) := f

@[simp] lemma forget_enrichment.hom_to_hom_of {X Y : C} (f : (𝟙_ W) ⟶ (X ⟶[W] Y)) :
  forget_enrichment.hom_to W (forget_enrichment.hom_of W f) = f := rfl
@[simp] lemma forget_enrichment.hom_of_hom_to {X Y : forget_enrichment W C} (f : X ⟶ Y) :
  forget_enrichment.hom_of W (forget_enrichment.hom_to W f) = f := rfl

/-- The identity in the "underlying" category of an enriched category. -/
@[simp] lemma forget_enrichment_id (X : forget_enrichment W C) :
  forget_enrichment.hom_to W (𝟙 X) = (e_id W (forget_enrichment.to W X : C)) :=
category.id_comp _

@[simp] lemma forget_enrichment_id' (X : C) :
  forget_enrichment.hom_of W (e_id W X) = (𝟙 (forget_enrichment.of W X : C)) :=
(forget_enrichment_id W (forget_enrichment.of W X)).symm

/-- Composition in the "underlying" category of an enriched category. -/
@[simp] lemma forget_enrichment_comp {X Y Z : forget_enrichment W C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  forget_enrichment.hom_to W (f ≫ g) = (((λ_ (𝟙_ W)).inv ≫
    (forget_enrichment.hom_to W f ⊗ forget_enrichment.hom_to W g)) ≫ e_comp W _ _ _) :=
rfl

end

/--
A `V`-functor `F` between `V`-enriched categories
has a `V`-morphism from `X ⟶[V] Y` to `F.obj X ⟶[V] F.obj Y`,
satisfying the usual axioms.
-/
structure enriched_functor
  (C : Type u₁) [enriched_category V C] (D : Type u₂) [enriched_category V D] :=
(obj : C → D)
(map : Π X Y : C, (X ⟶[V] Y) ⟶ (obj X ⟶[V] obj Y))
(map_id' : ∀ X : C, e_id V X ≫ map X X = e_id V (obj X) . obviously)
(map_comp' : ∀ X Y Z : C,
  e_comp V X Y Z ≫ map X Z = (map X Y ⊗ map Y Z) ≫ e_comp V (obj X) (obj Y) (obj Z) . obviously)

restate_axiom enriched_functor.map_id'
restate_axiom enriched_functor.map_comp'
attribute [simp, reassoc] enriched_functor.map_id
attribute [simp, reassoc] enriched_functor.map_comp

/-- The identity enriched functor. -/
@[simps]
def enriched_functor.id (C : Type u₁) [enriched_category V C] : enriched_functor V C C :=
{ obj := λ X, X,
  map := λ X Y, 𝟙 _, }

instance : inhabited (enriched_functor V C C) := ⟨enriched_functor.id V C⟩

/-- Composition of enriched functors. -/
@[simps]
def enriched_functor.comp {C : Type u₁} {D : Type u₂} {E : Type u₃}
  [enriched_category V C] [enriched_category V D] [enriched_category V E]
  (F : enriched_functor V C D) (G : enriched_functor V D E) :
  enriched_functor V C E :=
{ obj := λ X, G.obj (F.obj X),
  map := λ X Y, F.map _ _ ≫ G.map _ _, }

section
variables {W : Type (v+1)} [category.{v} W] [monoidal_category W]

/--
An enriched functor induces an honest functor of the underlying categories,
by mapping the `(𝟙_ W)`-shaped morphisms.
-/
def enriched_functor.forget {C : Type u₁} {D : Type u₂}
  [enriched_category W C] [enriched_category W D]
  (F : enriched_functor W C D) : (forget_enrichment W C) ⥤ (forget_enrichment W D) :=
{ obj := λ X, forget_enrichment.of W (F.obj (forget_enrichment.to W X)),
  map := λ X Y f, forget_enrichment.hom_of W
    (forget_enrichment.hom_to W f ≫ F.map (forget_enrichment.to W X) (forget_enrichment.to W Y)),
  map_comp' := λ X Y Z f g, begin
    dsimp,
    apply_fun forget_enrichment.hom_to W,
    { simp only [iso.cancel_iso_inv_left, category.assoc, tensor_comp,
        forget_enrichment.hom_to_hom_of, enriched_functor.map_comp, forget_enrichment_comp],
      refl, },
    { intros f g w, apply_fun forget_enrichment.hom_of W at w, simpa using w, },
  end, }

end

section
variables {V}
variables {D : Type u₂} [enriched_category V D]

/-!
We now turn to natural transformations between `V`-functors.

The mostly commonly encountered definition of an enriched natural transformation
is a collection of morphisms
```
(𝟙_ W) ⟶ (F.obj X ⟶[V] G.obj X)
```
satisfying an appropriate analogue of the naturality square.
(c.f. https://ncatlab.org/nlab/show/enriched+natural+transformation)

This is the same thing as a natural transformation `F.forget ⟶ G.forget`.

We formalize this as `enriched_nat_trans F G`, which is a `Type`.

However, there's also something much nicer: with appropriate additional hypotheses,
there is a `V`-object `enriched_nat_trans_obj F G` which contains more information,
and from which one can recover `enriched_nat_trans F G ≃ (𝟙_ V) ⟶ enriched_nat_trans_obj F G`.

Using these as the hom-objects, we can build a `V`-enriched category
with objects the `V`-functors.

For `enriched_nat_trans_obj` to exist, it suffices to have `V` braided and complete.

Before assuming `V` is complete, we assume it is braided and
define a presheaf `enriched_nat_trans_yoneda F G`
which is isomorphic to the Yoneda embedding of `enriched_nat_trans_obj F G`
whether or not that object actually exists.

This presheaf has components `(enriched_nat_trans_yoneda F G).obj A`
what we call the `A`-graded enriched natural transformations,
which are collections of morphisms
```
A ⟶ (F.obj X ⟶[V] G.obj X)
```
satisfying a similar analogue of the naturality square,
this time incorporating a half-braiding on `A`.

(We actually define `enriched_nat_trans F G`
as the special case `A := 𝟙_ V` with the trivial half-braiding,
and when defining `enriched_nat_trans_yoneda F G` we use the half-braidings
coming from the ambient braiding on `V`.)
-/

/--
The type of `A`-graded natural transformations between `V`-functors `F` and `G`.
This is the type of morphisms in `V` from `A` to the `V`-object of natural transformations.
-/
@[ext, nolint has_inhabited_instance]
structure graded_nat_trans (A : center V) (F G : enriched_functor V C D) :=
(app : Π (X : C), A.1 ⟶ (F.obj X ⟶[V] G.obj X))
(naturality :
  ∀ (X Y : C), (A.2.β (X ⟶[V] Y)).hom ≫ (F.map X Y ⊗ app Y) ≫ e_comp V _ _ _ =
    (app X ⊗ G.map X Y) ≫ e_comp V _ _ _)

variables [braided_category V]
open braided_category

/--
A presheaf isomorphic to the Yoneda embedding of
the `V`-object of natural transformations from `F` to `G`.
-/
@[simps]
def enriched_nat_trans_yoneda (F G : enriched_functor V C D) : Vᵒᵖ ⥤ (Type (max u₁ w)) :=
{ obj := λ A, graded_nat_trans ((center.of_braided V).obj (unop A)) F G,
  map := λ A A' f σ,
  { app := λ X, f.unop ≫ σ.app X,
    naturality := λ X Y, begin
      have p := σ.naturality X Y,
      dsimp at p ⊢,
      rw [←id_tensor_comp_tensor_id (f.unop ≫ σ.app Y) _, id_tensor_comp, category.assoc,
        category.assoc, ←braiding_naturality_assoc, id_tensor_comp_tensor_id_assoc, p,
        ←tensor_comp_assoc,category.id_comp],
     end }, }

-- TODO assuming `[has_limits C]` construct the actual object of natural transformations
-- and show that the functor category is `V`-enriched.

end

section
local attribute [instance] category_of_enriched_category_Type

/--
We verify that an enriched functor between `Type v` enriched categories
is just the same thing as an honest functor.
-/
@[simps]
def enriched_functor_Type_equiv_functor
  {C : Type u₁} [𝒞 : enriched_category (Type v) C]
  {D : Type u₂} [𝒟 : enriched_category (Type v) D] :
  enriched_functor (Type v) C D ≃ (C ⥤ D) :=
{ to_fun := λ F,
  { obj := λ X, F.obj X,
    map := λ X Y f, F.map X Y f,
    map_id' := λ X, congr_fun (F.map_id X) punit.star,
    map_comp' := λ X Y Z f g, congr_fun (F.map_comp X Y Z) ⟨f, g⟩, },
  inv_fun := λ F,
  { obj := λ X, F.obj X,
    map := λ X Y f, F.map f,
    map_id' := λ X, by { ext ⟨⟩, exact F.map_id X, },
    map_comp' := λ X Y Z, by { ext ⟨f, g⟩, exact F.map_comp f g, }, },
  left_inv := λ F, by { cases F, simp, },
  right_inv := λ F, by { cases F, simp, }, }

/--
We verify that the presheaf representing natural transformations
between `Type v`-enriched functors is actually represented by
the usual type of natural transformations!
-/
def enriched_nat_trans_yoneda_Type_iso_yoneda_nat_trans
  {C : Type v} [enriched_category (Type v) C]
  {D : Type v} [enriched_category (Type v) D]
  (F G : enriched_functor (Type v) C D) :
  enriched_nat_trans_yoneda F G ≅
  yoneda.obj ((enriched_functor_Type_equiv_functor F) ⟶ (enriched_functor_Type_equiv_functor G)) :=
nat_iso.of_components (λ α,
  { hom := λ σ x,
    { app := λ X, σ.app X x,
      naturality' := λ X Y f, congr_fun (σ.naturality X Y) ⟨x, f⟩, },
    inv := λ σ,
    { app := λ X x, (σ x).app X,
      naturality := λ X Y, by { ext ⟨x, f⟩, exact ((σ x).naturality f), }, }})
  (by tidy)

end

end category_theory


import may_assume.lemmas
import number_theory.cyclotomic.factoring
import number_theory.cyclotomic.Unit_lemmas
import number_theory.cyclotomic.case_I

open finset nat is_cyclotomic_extension ideal polynomial int basis

open_locale big_operators number_field

local attribute [-instance] cyclotomic_field.algebra

namespace flt_regular

variables {p : ℕ} (hpri : p.prime)

local notation `P` := (⟨p, hpri.pos⟩ : ℕ+)
local notation `K` := cyclotomic_field P ℚ
local notation `R` := 𝓞 K

namespace caseI

lemma two_lt (hp5 : 5 ≤ p) : 2 < p := by linarith

section zerok₁

lemma aux_cong0k₁ {k : fin p} (hcong : k ≡ -1 [ZMOD p]) : k = ⟨p.pred, pred_lt hpri.ne_zero⟩ :=
begin
  refine fin.ext _,
  rw [fin.coe_mk, ← zmod.val_cast_of_lt (fin.is_lt k)],
  suffices : ((k : ℤ) : zmod p).val = p.pred, simpa,
  rw [← zmod.int_coe_eq_int_coe_iff] at hcong,
  rw [hcong, cast_neg, int.cast_one, pred_eq_sub_one],
  haveI : ne_zero p := ⟨hpri.ne_zero⟩,
  haveI : fact (p.prime) := ⟨hpri⟩,
  haveI : fact (1 < p) := ⟨hpri.one_lt⟩,
  simp [zmod.neg_val, zmod.val_one]
end

/-- Auxiliary function. -/
def f0k₁ (b : ℤ) (p : ℕ) : ℕ → ℤ := λ x, if x = 1 then b else if x = p.pred then -b else 0

lemma auxf0k₁ (hp5 : 5 ≤ p) (b : ℤ) : ∃ i : fin P, f0k₁ b p (i : ℕ) = 0 :=
begin
  refine ⟨⟨2, two_lt hp5⟩, _⟩,
  have h1 : ((⟨2, two_lt hp5⟩ : fin p) : ℕ) ≠ 1,
  { intro h,
    simp only [fin.ext_iff, fin.coe_mk] at h,
    exact one_lt_two.ne h.symm },
  have hpred : ((⟨2, two_lt hp5⟩ : fin p) : ℕ) ≠ p.pred,
  { intro h,
    simp only [fin.ext_iff, fin.coe_mk] at h,
    replace h := h.symm,
    rw [nat.pred_eq_succ_iff] at h,
    linarith },
  simp only [f0k₁, h1, if_false, hpred]
end

lemma aux0k₁ {a b c : ℤ} {ζ : R} (hp5 : 5 ≤ p) (hζ : is_primitive_root ζ p)
  (caseI : ¬ ↑p ∣ a * b * c) {k₁ k₂ : fin p} (hcong : k₂ ≡ k₁ - 1 [ZMOD p])
  (hdiv : ↑p ∣ ↑a + ↑b * ζ - ↑a * ζ ^ (k₁ : ℕ) - ↑b * ζ ^ (k₂ : ℕ)) : 0 ≠ ↑k₁ :=
begin
  haveI := (⟨hpri⟩ : fact ((P : ℕ).prime)),
  haveI diamond : is_cyclotomic_extension {P} ℚ K,
  { convert cyclotomic_field.is_cyclotomic_extension P ℚ,
    exact subsingleton.elim _ _ },

  symmetry,
  intro habs,
  rw [show (k₁ : ℤ) = 0, by simpa using habs, zero_sub] at hcong,
  rw [habs, pow_zero, mul_one, add_sub_cancel', aux_cong0k₁ hpri hcong] at hdiv,
  nth_rewrite 0 [show ζ = ζ ^ ((⟨1, hpri.one_lt⟩ : fin p) : ℕ), by simp] at hdiv,
  have key : ↑(p : ℤ) ∣ ∑ j in range p, (f0k₁ b p j) • ζ ^ j,
  { convert hdiv using 1,
    { simp },
    have h : 1 ≠ p.pred := λ h, by linarith [pred_eq_succ_iff.1 h.symm],
    simp_rw [f0k₁, ite_smul, sum_ite, filter_filter, ← ne.def, ne_and_eq_iff_right h,
      finset.range_filter_eq],
    simp [hpri.one_lt, pred_lt (hpri.ne_zero), sub_eq_add_neg] },
  rw [sum_range] at key,
  refine caseI (has_dvd.dvd.mul_right (has_dvd.dvd.mul_left _ _) _),
  simpa [f0k₁] using dvd_coeff_cycl_integer (by exact hζ) (auxf0k₁ hpri hp5 b) key ⟨1, hpri.one_lt⟩,
end

end zerok₁

section zerok₂

/-- Auxiliary function -/
def f0k₂ (a b : ℤ) : ℕ → ℤ := λ x, if x = 0 then a - b else if x = 1 then b - a else 0

lemma aux_cong0k₂ {k : fin p} (hcong : k ≡ 1 [ZMOD p]) : k = ⟨1, hpri.one_lt⟩ :=
begin
  refine fin.ext _,
  rw [fin.coe_mk, ← zmod.val_cast_of_lt (fin.is_lt k)],
  suffices : ((k : ℤ) : zmod p).val = 1, simpa,
  rw [← zmod.int_coe_eq_int_coe_iff] at hcong,
  rw [hcong, int.cast_one],
  haveI : fact (p.prime) := ⟨hpri⟩,
  simp [zmod.val_one]
end

lemma auxf0k₂ (hp5 : 5 ≤ p) (a b : ℤ) : ∃ i : fin P, f0k₂ a b (i : ℕ) = 0 :=
begin
  refine ⟨⟨2, two_lt hp5⟩, _⟩,
  have h1 : ((⟨2, two_lt hp5⟩ : fin p) : ℕ) ≠ 1,
  { intro h,
    simp only [fin.ext_iff, fin.coe_mk] at h,
    exact one_lt_two.ne h.symm },
  have hzero : ((⟨2, two_lt hp5⟩ : fin p) : ℕ) ≠ 0,
  { intro h,
    simp only [fin.ext_iff, fin.coe_mk] at h,
    linarith },
  simp only [f0k₂, h1, if_false, hzero]
end

lemma aux0k₂ {a b : ℤ} {ζ : R} (hp5 : 5 ≤ p) (hζ : is_primitive_root ζ p)
  (hab : ¬a ≡ b [ZMOD p]) {k₁ k₂ : fin p} (hcong : k₂ ≡ k₁ - 1 [ZMOD p])
  (hdiv : ↑p ∣ ↑a + ↑b * ζ - ↑a * ζ ^ (k₁ : ℕ) - ↑b * ζ ^ (k₂ : ℕ)) : 0 ≠ ↑k₂ :=
begin
  haveI := (⟨hpri⟩ : fact ((P : ℕ).prime)),
  haveI diamond : is_cyclotomic_extension {P} ℚ K,
  { convert cyclotomic_field.is_cyclotomic_extension P ℚ,
    exact subsingleton.elim _ _ },

  symmetry,
  intro habs,
  replace hcong := hcong.symm,
  rw [show (k₂ : ℤ) = 0, by simpa using habs, ← zmod.int_coe_eq_int_coe_iff,
    int.cast_sub, int.cast_zero, sub_eq_zero, zmod.int_coe_eq_int_coe_iff] at hcong,
  rw [habs, pow_zero, mul_one, aux_cong0k₂ hpri hcong, fin.coe_mk, pow_one, add_sub_assoc,
    ← sub_mul, add_sub_right_comm, show ζ = ζ ^ ((⟨1, hpri.one_lt⟩ : fin p) : ℕ), by simp,
    ← neg_sub ↑a, neg_mul, ← sub_eq_add_neg] at hdiv,
  have key : ↑(p : ℤ) ∣ ∑ j in range p, (f0k₂ a b j) • ζ ^ j,
  { convert hdiv using 1,
    { simp },
    simp_rw [f0k₂, ite_smul, sum_ite, filter_filter, ← ne.def, ne_and_eq_iff_right zero_ne_one,
      finset.range_filter_eq],
    simp only [hpri.pos, hpri.one_lt, if_true, zsmul_eq_mul, int.cast_sub, sum_singleton, pow_zero,
      mul_one, pow_one, ne.def, filter_congr_decidable, zero_smul, sum_const_zero, add_zero,
      fin.coe_mk],
    ring },
  rw [sum_range] at key,
  refine hab _,
  symmetry,
  rw [← zmod.int_coe_eq_int_coe_iff, zmod.int_coe_eq_int_coe_iff_dvd_sub],
  simpa [f0k₂] using dvd_coeff_cycl_integer (by exact hζ) (auxf0k₂ hpri hp5 a b) key ⟨0, hpri.pos⟩
end

end zerok₂

section onek_one

lemma aux_cong1k₁ {k : fin p} (hcong : k ≡ 0 [ZMOD p]) : k = ⟨0, hpri.pos⟩ :=
begin
  refine fin.ext _,
  rw [fin.coe_mk, ← zmod.val_cast_of_lt (fin.is_lt k)],
  suffices : ((k : ℤ) : zmod p).val = 0, simpa,
  rw [← zmod.int_coe_eq_int_coe_iff] at hcong,
  rw [hcong, int.cast_zero],
  haveI : fact (p.prime) := ⟨hpri⟩,
  simp
end

lemma aux1k₁ {a b : ℤ} {ζ : R} (hp5 : 5 ≤ p) (hζ : is_primitive_root ζ p)
  (hab : ¬a ≡ b [ZMOD p]) {k₁ k₂ : fin p} (hcong : k₂ ≡ k₁ - 1 [ZMOD p])
  (hdiv : ↑p ∣ ↑a + ↑b * ζ - ↑a * ζ ^ (k₁ : ℕ) - ↑b * ζ ^ (k₂ : ℕ)) : 1 ≠ ↑k₁ :=
begin
  intro habs,
  have h := aux0k₂ hpri hp5 hζ hab hcong hdiv,
  rw [show (k₁ : ℤ) = 1, by simpa using habs.symm, sub_self] at hcong,
  have := (aux_cong1k₁ hpri hcong),
  simp only [←fin.coe_eq_coe, fin.coe_mk] at this,
  exact h.symm this
end

end onek_one

section onek_two

/-- Auxiliary function -/
def f1k₂ (a : ℤ) : ℕ → ℤ := λ x, if x = 0 then a else if x = 2 then -a else 0

lemma aux_cong1k₂ {k : fin p} (hpri : p.prime) (hp5 : 5 ≤ p) (hcong : k ≡ 1 + 1 [ZMOD p]) :
  k = ⟨2, two_lt hp5⟩ :=
begin
  refine fin.ext _,
  rw [fin.coe_mk, ← zmod.val_cast_of_lt (fin.is_lt k)],
  suffices : ((k : ℤ) : zmod p).val = 2, simpa,
  rw [← zmod.int_coe_eq_int_coe_iff] at hcong,
  rw [hcong],
  simp only [int.cast_add, algebra_map.coe_one],
  haveI : fact (p.prime) := ⟨hpri⟩,
  have := congr_arg nat.succ (nat.succ_pred_eq_of_pos hpri.pred_pos),
  rw [succ_pred_prime hpri] at this,
  rw [zmod.val_add, zmod.val_one, ← nat.mod_add_mod, ← this, one_mod, this, nat.mod_eq_of_lt],
  linarith
end

lemma auxf1k₂ (a : ℤ) : ∃ i : fin P, f1k₂ a (i : ℕ) = 0 :=
begin
  refine ⟨⟨1, hpri.one_lt⟩, _⟩,
  have h2 : ((⟨1, hpri.one_lt⟩ : fin p) : ℕ) ≠ 2,
  { intro h,
    simp only [fin.ext_iff, fin.coe_mk] at h,
    linarith },
  have hzero : ((⟨1, hpri.one_lt⟩ : fin p) : ℕ) ≠ 0,
  { intro h,
    simp only [fin.ext_iff, fin.coe_mk] at h,
    linarith },
  simp only [f1k₂, h2, if_false, hzero]
end

lemma aux1k₂ {a b c : ℤ} {ζ : R} (hp5 : 5 ≤ p) (hζ : is_primitive_root ζ p)
  (caseI : ¬ ↑p ∣ a * b * c) {k₁ k₂ : fin p} (hcong : k₂ ≡ k₁ - 1 [ZMOD p])
  (hdiv : ↑p ∣ ↑a + ↑b * ζ - ↑a * ζ ^ (k₁ : ℕ) - ↑b * ζ ^ (k₂ : ℕ)) : 1 ≠ ↑k₂ :=
begin
  haveI := (⟨hpri⟩ : fact ((P : ℕ).prime)),
  haveI diamond : is_cyclotomic_extension {P} ℚ K,
  { convert cyclotomic_field.is_cyclotomic_extension P ℚ,
    exact subsingleton.elim _ _ },

  symmetry,
  intro habs,
  replace hcong := hcong.symm,
  rw [show (k₂ : ℤ) = 1, by simpa using habs, ← zmod.int_coe_eq_int_coe_iff, int.cast_sub,
    sub_eq_iff_eq_add, ← int.cast_add, zmod.int_coe_eq_int_coe_iff] at hcong,
  rw [habs, pow_one, (aux_cong1k₂ hpri hp5 hcong)] at hdiv,
  ring_nf at hdiv,
  rw [add_mul, one_mul, add_comm, mul_comm, mul_neg] at hdiv,
  have key : ↑(p : ℤ) ∣ ∑ j in range p, (f1k₂ a j) • ζ ^ j,
  { convert hdiv using 1,
    { simp },
    simp_rw [f1k₂, ite_smul, sum_ite, filter_filter, ← ne.def, ne_and_eq_iff_right
      (show 0 ≠ 2, by norm_num), finset.range_filter_eq],
    simp [hpri.pos, two_lt hp5, fin.coe_mk (two_lt hp5),eq_self_iff_true, -fin.mk_bit0] },
  rw [sum_range] at key,
  refine caseI (has_dvd.dvd.mul_right (has_dvd.dvd.mul_right _ _) _),
  simpa [f1k₂] using dvd_coeff_cycl_integer (by exact hζ) (auxf1k₂ hpri a) key ⟨0, hpri.pos⟩
end

end onek_two

section kone_ktwo

lemma auxk₁k₂ {k₁ k₂ : fin p} (hpri : p.prime) (hcong : k₂ ≡ k₁ - 1 [ZMOD p]) : (k₁ : ℕ) ≠ (k₂ : ℕ) :=
begin
  haveI := (⟨hpri⟩ : fact (p.prime)),
  intro habs,
  rw [show (k₁ : ℤ) = (k₂ : ℕ), by simpa using habs, ← zmod.int_coe_eq_int_coe_iff, ← sub_eq_zero,
    int.cast_sub, sub_sub_eq_add_sub, coe_coe, add_sub_cancel', algebra_map.coe_one] at hcong,
  exact one_ne_zero hcong
end

end kone_ktwo

end caseI

end flt_regular