/-
Copyright (c) 2021 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module tactic.itauto
! leanprover-community/mathlib commit dff8393cf1d1fc152d148e13fe57452fc37d4852
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Hint

/-!

# Intuitionistic tautology (`itauto`) decision procedure

The `itauto` tactic will prove any intuitionistic tautology. It implements the well known
`G4ip` algorithm:
[Dyckhoff, *Contraction-free sequent calculi for intuitionistic logic*][dyckhoff_1992].

All built in propositional connectives are supported: `true`, `false`, `and`, `or`, `implies`,
`not`, `iff`, `xor`, as well as `eq` and `ne` on propositions. Anything else, including definitions
and predicate logical connectives (`forall` and `exists`), are not supported, and will have to be
simplified or instantiated before calling this tactic.

The resulting proofs will never use any axioms except possibly `propext`, and `propext` is only
used if the input formula contains an equality of propositions `p = q`.

## Implementation notes

The core logic of the prover is in three functions:

* `prove : context → prop → state_t ℕ option proof`: The main entry point.
  Gets a context and a goal, and returns a `proof` object or fails, using `state_t ℕ` for the name
  generator.
* `search : context → prop → state_t ℕ option proof`: Same meaning as `proof`, called during the
  search phase (see below).
* `context.add : prop → proof → context → except (prop → proof) context`: Adds a proposition with
  its proof into the context, but it also does some simplifications on the spot while doing so.
  It will either return the new context, or if it happens to notice a proof of false, it will
  return a function to compute a proof of any proposition in the original context.

The intuitionistic logic rules are separated into three groups:

* level 1: No splitting, validity preserving: apply whenever you can.
  Left rules in `context.add`, right rules in `prove`.
  * `context.add`:
    * simplify `Γ, ⊤ ⊢ B` to `Γ ⊢ B`
    * `Γ, ⊥ ⊢ B` is true
    * simplify `Γ, A ∧ B ⊢ C` to `Γ, A, B ⊢ C`
    * simplify `Γ, ⊥ → A ⊢ B` to `Γ ⊢ B`
    * simplify `Γ, ⊤ → A ⊢ B` to `Γ, A ⊢ B`
    * simplify `Γ, A ∧ B → C ⊢ D` to `Γ, A → B → C ⊢ D`
    * simplify `Γ, A ∨ B → C ⊢ D` to `Γ, A → C, B → C ⊢ D`
  * `prove`:
    * `Γ ⊢ ⊤` is true
    * simplify `Γ ⊢ A → B` to `Γ, A ⊢ B`
  * `search`:
    * `Γ, P ⊢ P` is true
    * simplify `Γ, P, P → A ⊢ B` to `Γ, P, A ⊢ B`
* level 2: Splitting rules, validity preserving: apply after level 1 rules. Done in `prove`
  * simplify `Γ ⊢ A ∧ B` to `Γ ⊢ A` and `Γ ⊢ B`
  * simplify `Γ, A ∨ B ⊢ C` to `Γ, A ⊢ C` and `Γ, B ⊢ C`
* level 3: Splitting rules, not validity preserving: apply only if nothing else applies.
  Done in `search`
  * `Γ ⊢ A ∨ B` follows from `Γ ⊢ A`
  * `Γ ⊢ A ∨ B` follows from `Γ ⊢ B`
  * `Γ, (A₁ → A₂) → C ⊢ B` follows from `Γ, A₂ → C, A₁ ⊢ A₂` and `Γ, C ⊢ B`

This covers the core algorithm, which only handles `true`, `false`, `and`, `or`, and `implies`.
For `iff` and `eq`, we treat them essentially the same as `(p → q) ∧ (q → p)`, although we use
a different `prop` representation because we have to remember to apply different theorems during
replay. For definitions like `not` and `xor`, we just eagerly unfold them. (This could potentially
cause a blowup issue for `xor`, but it isn't used very often anyway. We could add it to the `prop`
grammar if it matters.)

## Tags

propositional logic, intuitionistic logic, decision procedure
-/

namespace Tactic

namespace Itauto

/-- Different propositional constructors that are variants of "and" for the purposes of the
theorem prover. -/
inductive AndKind
  | And
  | Iff
  | Eq
  deriving has_reflect, DecidableEq
#align tactic.itauto.and_kind Tactic.Itauto.AndKind

instance : Inhabited AndKind :=
  ⟨AndKind.and⟩

/-- A reified inductive type for propositional logic. -/
inductive Prop : Type
  | var : ℕ → prop-- propositional atoms P_i

  | True : prop-- ⊤

  | False : prop-- ⊥

  | and' : AndKind → prop → prop → prop-- p ∧ q, p ↔ q, p = q

  | Or : prop → prop → prop-- p ∨ q

  | imp : prop → prop → prop
  deriving has_reflect, DecidableEq
#align tactic.itauto.prop Tactic.Itauto.Prop

-- p → q
/-- Constructor for `p ∧ q`. -/
@[match_pattern]
def Prop.and : Prop → Prop → Prop :=
  Prop.and' AndKind.and
#align tactic.itauto.prop.and Tactic.Itauto.Prop.and

/-- Constructor for `p ↔ q`. -/
@[match_pattern]
def Prop.iff : Prop → Prop → Prop :=
  Prop.and' AndKind.iff
#align tactic.itauto.prop.iff Tactic.Itauto.Prop.iff

/-- Constructor for `p = q`. -/
@[match_pattern]
def Prop.eq : Prop → Prop → Prop :=
  Prop.and' AndKind.eq
#align tactic.itauto.prop.eq Tactic.Itauto.Prop.eq

/-- Constructor for `¬ p`. -/
@[match_pattern]
def Prop.not (a : Prop) : Prop :=
  a.imp Prop.false
#align tactic.itauto.prop.not Tactic.Itauto.Prop.not

/-- Constructor for `xor p q`. -/
@[match_pattern]
def Prop.xor (a b : Prop) : Prop :=
  (a.And b.Not).Or (b.And a.Not)
#align tactic.itauto.prop.xor Tactic.Itauto.Prop.xor

instance : Inhabited Prop :=
  ⟨Prop.true⟩

/-- Given the contents of an `and` variant, return the two conjuncts. -/
def AndKind.sides : AndKind → Prop → Prop → Prop × Prop
  | and_kind.and, A, B => (A, B)
  | _, A, B => (A.imp B, B.imp A)
#align tactic.itauto.and_kind.sides Tactic.Itauto.AndKind.sides

/-- Debugging printer for propositions. -/
unsafe def prop.to_format : Prop → format
  | prop.var i => f! "v{i}"
  | prop.true => f!"⊤"
  | prop.false => f!"⊥"
  | prop.and p q => f! "({p.to_format } ∧ {q.to_format})"
  | prop.iff p q => f! "({p.to_format } ↔ {q.to_format})"
  | prop.eq p q => f! "({p.to_format } = {q.to_format})"
  | prop.or p q => f! "({p.to_format } ∨ {q.to_format})"
  | prop.imp p q => f! "({p.to_format } → {q.to_format})"
#align tactic.itauto.prop.to_format tactic.itauto.prop.to_format

unsafe instance : has_to_format Prop :=
  ⟨prop.to_format⟩

section

open Ordering

/-- A comparator for `and_kind`. (There should really be a derive handler for this.) -/
def AndKind.cmp (p q : AndKind) : Ordering :=
  by
  cases p <;> cases q
  exacts[Eq, lt, lt, GT.gt, Eq, lt, GT.gt, GT.gt, Eq]
#align tactic.itauto.and_kind.cmp Tactic.Itauto.AndKind.cmp

/-- A comparator for propositions. (There should really be a derive handler for this.) -/
def Prop.cmp (p q : Prop) : Ordering :=
  by
  induction' p with _ ap _ _ p₁ p₂ _ _ p₁ p₂ _ _ p₁ p₂ _ _ p₁ p₂ generalizing q <;> cases q
  case var.var => exact cmp p q
  case true.true => exact Eq
  case false.false => exact Eq
  case and'.and' aq q₁ q₂ => exact (ap.cmp aq).orElse ((p₁ q₁).orElse (p₂ q₂))
  case or.or q₁ q₂ => exact (p₁ q₁).orElse (p₂ q₂)
  case imp.imp q₁ q₂ => exact (p₁ q₁).orElse (p₂ q₂)
  exacts[lt, lt, lt, lt, lt, GT.gt, lt, lt, lt, lt, GT.gt, GT.gt, lt, lt, lt, GT.gt, GT.gt, GT.gt,
    lt, lt, GT.gt, GT.gt, GT.gt, GT.gt, lt, GT.gt, GT.gt, GT.gt, GT.gt, GT.gt]
#align tactic.itauto.prop.cmp Tactic.Itauto.Prop.cmp

instance : LT Prop :=
  ⟨fun p q => p.cmp q = lt⟩

instance : DecidableRel (@LT.lt Prop _) := fun _ _ => Ordering.decidableEq _ _

end

/-- A reified inductive proof type for intuitionistic propositional logic. -/
inductive Proof-- ⊢ A, causes failure during reconstruction

  | sorry : proof-- (n: A) ⊢ A

  | hyp (n : Name) : proof-- ⊢ ⊤

  | triv : proof-- (p: ⊥) ⊢ A

  | exfalso' (p : proof) : proof-- (p: (x: A) ⊢ B) ⊢ A → B

  | intro (x : Name) (p : proof) : proof-- ak = and:  (p: A ∧ B) ⊢ A
-- ak = iff:  (p: A ↔ B) ⊢ A → B
-- ak = eq:  (p: A = B) ⊢ A → B

  | and_left (ak : AndKind) (p : proof) : proof-- ak = and:  (p: A ∧ B) ⊢ B
-- ak = iff:  (p: A ↔ B) ⊢ B → A
-- ak = eq:  (p: A = B) ⊢ B → A

  | and_right (ak : AndKind) (p : proof) : proof-- ak = and:  (p₁: A) (p₂: B) ⊢ A ∧ B
-- ak = iff:  (p₁: A → B) (p₁: B → A) ⊢ A ↔ B
-- ak = eq:  (p₁: A → B) (p₁: B → A) ⊢ A = B

  | and_intro (ak : AndKind) (p₁ p₂ : proof) : proof-- ak = and:  (p: A ∧ B → C) ⊢ A → B → C
-- ak = iff:  (p: (A ↔ B) → C) ⊢ (A → B) → (B → A) → C
-- ak = eq:  (p: (A = B) → C) ⊢ (A → B) → (B → A) → C

  | curry (ak : AndKind) (p : proof) : proof-- This is a partial application of curry.
-- ak = and:  (p: A ∧ B → C) (q : A) ⊢ B → C
-- ak = iff:  (p: (A ↔ B) → C) (q: A → B) ⊢ (B → A) → C
-- ak = eq:  (p: (A ↔ B) → C) (q: A → B) ⊢ (B → A) → C

  | curry₂ (ak : AndKind) (p q : proof) : proof-- (p: A → B) (q: A) ⊢ B

  | app' : proof → proof → proof-- (p: A ∨ B → C) ⊢ A → C

  | or_imp_left (p : proof) : proof-- (p: A ∨ B → C) ⊢ B → C

  | or_imp_right (p : proof) : proof-- (p: A) ⊢ A ∨ B

  | or_inl (p : proof) : proof-- (p: B) ⊢ A ∨ B

  | or_inr (p : proof) : proof-- (p: B) ⊢ A ∨ B
-- (p₁: A ∨ B) (p₂: (x: A) ⊢ C) (p₃: (x: B) ⊢ C) ⊢ C

  |
  or_elim' (p₁ : proof) (x : Name) (p₂ p₃ : proof) :
    proof-- (p₁: decidable A) (p₂: (x: A) ⊢ C) (p₃: (x: ¬ A) ⊢ C) ⊢ C

  |
  decidable_elim (classical : Bool) (p₁ x : Name) (p₂ p₃ : proof) :
    proof-- classical = ff: (p: decidable A) ⊢ A ∨ ¬A
-- classical = tt: (p: Prop) ⊢ p ∨ ¬p

  |
  em (classical : Bool) (p : Name) :
    proof-- The variable x here names the variable that will be used in the elaborated proof
-- (p: ((x:A) → B) → C) ⊢ B → C

  | imp_imp_simp (x : Name) (p : proof) : proof
  deriving has_reflect
#align tactic.itauto.proof Tactic.Itauto.Proof

instance : Inhabited Proof :=
  ⟨Proof.triv⟩

/-- Debugging printer for proof objects. -/
unsafe def proof.to_format : Proof → format
  | proof.sorry => "sorry"
  | proof.hyp i => to_fmt i
  | proof.triv => "triv"
  | proof.exfalso' p => f! "(exfalso {p.to_format})"
  | proof.intro x p => f! "(λ {x }, {p.to_format})"
  | proof.and_left _ p => f! "{p.to_format} .1"
  | proof.and_right _ p => f! "{p.to_format} .2"
  | proof.and_intro _ p q => f! "⟨{p.to_format }, {q.to_format}⟩"
  | proof.curry _ p => f! "(curry {p.to_format})"
  | proof.curry₂ _ p q => f! "(curry {p.to_format } {q.to_format})"
  | proof.app' p q => f! "({p.to_format } {q.to_format})"
  | proof.or_imp_left p => f! "(or_imp_left {p.to_format})"
  | proof.or_imp_right p => f! "(or_imp_right {p.to_format})"
  | proof.or_inl p => f! "(or.inl {p.to_format})"
  | proof.or_inr p => f! "(or.inr {p.to_format})"
  | proof.or_elim' p x q r =>
    f! "({p.to_format }.elim (λ {x }, {q.to_format }) (λ {x }, {r.to_format})"
  | proof.em ff p => f! "(decidable.em {p})"
  | proof.em tt p => f! "(classical.em {p})"
  | proof.decidable_elim _ p x q r =>
    f! "({p }.elim (λ {x }, {q.to_format }) (λ {x }, {r.to_format})"
  | proof.imp_imp_simp _ p => f! "(imp_imp_simp {p.to_format})"
#align tactic.itauto.proof.to_format tactic.itauto.proof.to_format

unsafe instance : has_to_format Proof :=
  ⟨proof.to_format⟩

/-- A variant on `proof.exfalso'` that performs opportunistic simplification. -/
unsafe def proof.exfalso : Prop → Proof → Proof
  | prop.false, p => p
  | A, p => Proof.exfalso' p
#align tactic.itauto.proof.exfalso tactic.itauto.proof.exfalso

/-- A variant on `proof.or_elim` that performs opportunistic simplification. -/
unsafe def proof.or_elim : Proof → Name → Proof → Proof → Proof
  | proof.em cl p, x, q, r => Proof.decidable_elim cl p x q r
  | p, x, q, r => Proof.or_elim' p x q r
#align tactic.itauto.proof.or_elim tactic.itauto.proof.or_elim

/-- A variant on `proof.app'` that performs opportunistic simplification.
(This doesn't do full normalization because we don't want the proof size to blow up.) -/
unsafe def proof.app : Proof → Proof → Proof
  | proof.curry ak p, q => Proof.curry₂ ak p q
  | proof.curry₂ ak p q, r => p.app (q.and_intro ak r)
  | proof.or_imp_left p, q => p.app q.or_inl
  | proof.or_imp_right p, q => p.app q.or_inr
  | proof.imp_imp_simp x p, q => p.app (Proof.intro x q)
  | p, q => p.app' q
#align tactic.itauto.proof.app tactic.itauto.proof.app

-- Note(Mario): the typechecker is disabled because it requires proofs to carry around additional
-- props. These can be retrieved from the git history if you want to re-enable this.
/-
/-- A typechecker for the `proof` type. This is not used by the tactic but can be used for
debugging. -/
meta def proof.check : name_map prop → proof → option prop
| Γ (proof.hyp i) := Γ.find i
| Γ proof.triv := some prop.true
| Γ (proof.exfalso' A p) := guard (p.check Γ = some prop.false) $> A
| Γ (proof.intro x A p) := do B ← p.check (Γ.insert x A), pure (prop.imp A B)
| Γ (proof.and_left ak p) := do
  prop.and' ak' A B ← p.check Γ | none,
  guard (ak = ak') $> (ak.sides A B).1
| Γ (proof.and_right ak p) := do
  prop.and' ak' A B ← p.check Γ | none,
  guard (ak = ak') $> (ak.sides A B).2
| Γ (proof.and_intro and_kind.and p q) := do
  A ← p.check Γ, B ← q.check Γ,
  pure (A.and B)
| Γ (proof.and_intro ak p q) := do
  prop.imp A B ← p.check Γ | none,
  C ← q.check Γ, guard (C = prop.imp B A) $> (A.and' ak B)
| Γ (proof.curry ak p) := do
  prop.imp (prop.and' ak' A B) C ← p.check Γ | none,
  let (A', B') := ak.sides A B,
  guard (ak = ak') $> (A'.imp $ B'.imp C)
| Γ (proof.curry₂ ak p q) := do
  prop.imp (prop.and' ak' A B) C ← p.check Γ | none,
  A₂ ← q.check Γ,
  let (A', B') := ak.sides A B,
  guard (ak = ak' ∧ A₂ = A') $> (B'.imp C)
| Γ (proof.app' p q) := do prop.imp A B ← p.check Γ | none, A' ← q.check Γ, guard (A = A') $> B
| Γ (proof.or_imp_left B p) := do
  prop.imp (prop.or A B') C ← p.check Γ | none,
  guard (B = B') $> (A.imp C)
| Γ (proof.or_imp_right A p) := do
  prop.imp (prop.or A' B) C ← p.check Γ | none,
  guard (A = A') $> (B.imp C)
| Γ (proof.or_inl B p) := do A ← p.check Γ | none, pure (A.or B)
| Γ (proof.or_inr A p) := do B ← p.check Γ | none, pure (A.or B)
| Γ (proof.or_elim p x q r) := do
  prop.or A B ← p.check Γ | none,
  C ← q.check (Γ.insert x A),
  C' ← r.check (Γ.insert x B),
  guard (C = C') $> C
| Γ (proof.imp_imp_simp x A p) := do
  prop.imp (prop.imp A' B) C ← p.check Γ | none,
  guard (A = A') $> (B.imp C)
-/
/-- Get a new name in the pattern `h0, h1, h2, ...` -/
@[inline]
unsafe def fresh_name : ℕ → Name × ℕ := fun n => (mkSimpleName ("h" ++ toString n), n + 1)
#align tactic.itauto.fresh_name tactic.itauto.fresh_name

/-- The context during proof search is a map from propositions to proof values. -/
unsafe def context :=
  native.rb_map Prop Proof
#align tactic.itauto.context tactic.itauto.context

/-- Debug printer for the context. -/
unsafe def context.to_format (Γ : context) : format :=
  Γ.fold "" fun P p f =>
    -- ++ " := " ++ p.to_format
          P.to_format ++
        ",\n" ++
      f
#align tactic.itauto.context.to_format tactic.itauto.context.to_format

unsafe instance : has_to_format context :=
  ⟨context.to_format⟩

/-- Insert a proposition and its proof into the context, as in `have : A := p`. This will eagerly
apply all level 1 rules on the spot, which are rules that don't split the goal and are validity
preserving: specifically, we drop `⊤` and `A → ⊤` hypotheses, close the goal if we find a `⊥`
hypothesis, split all conjunctions, and also simplify `⊥ → A` (drop), `⊤ → A` (simplify to `A`),
`A ∧ B → C` (curry to `A → B → C`) and `A ∨ B → C` (rewrite to `(A → C) ∧ (B → C)` and split). -/
unsafe def context.add : Prop → Proof → context → Except (Prop → Proof) context
  | prop.true, p, Γ => pure Γ
  | prop.false, p, Γ => Except.error fun A => proof.exfalso A p
  | prop.and' ak A B, p, Γ => do
    let (A, B) := ak.sides A B
    let Γ ← Γ.add A (p.and_left ak)
    Γ B (p ak)
  | prop.imp prop.false A, p, Γ => pure Γ
  | prop.imp prop.true A, p, Γ => Γ.add A (p.app Proof.triv)
  | prop.imp (prop.and' ak A B) C, p, Γ =>
    let (A, B) := ak.sides A B
    Γ.add (Prop.imp A (B.imp C)) (p.curry ak)
  | prop.imp (prop.or A B) C, p, Γ => do
    let Γ ← Γ.add (A.imp C) p.or_imp_left
    Γ (B C) p
  | prop.imp A prop.true, p, Γ => pure Γ
  | A, p, Γ => pure (Γ.insert A p)
#align tactic.itauto.context.add tactic.itauto.context.add

/-- Add `A` to the context `Γ` with proof `p`. This version of `context.add` takes a continuation
and a target proposition `B`, so that in the case that `⊥` is found we can skip the continuation
and just prove `B` outright. -/
@[inline]
unsafe def context.with_add (Γ : context) (A : Prop) (p : Proof) (B : Prop)
    (f : context → Prop → ℕ → Bool × Proof × ℕ) (n : ℕ) : Bool × Proof × ℕ :=
  match Γ.add A p with
  | Except.ok Γ_A => f Γ_A B n
  | Except.error p => (true, p B, n)
#align tactic.itauto.context.with_add tactic.itauto.context.with_add

/-- Map a function over the proof (regardless of whether the proof is successful or not). -/
def mapProof (f : Proof → Proof) : Bool × Proof × ℕ → Bool × Proof × ℕ
  | (b, p, n) => (b, f p, n)
#align tactic.itauto.map_proof Tactic.Itauto.mapProof

/-- Convert a value-with-success to an optional value. -/
def isOk {α} : Bool × α → Option α
  | (ff, p) => none
  | (tt, p) => some p
#align tactic.itauto.is_ok Tactic.Itauto.isOk

/-- Skip the continuation and return a failed proof if the boolean is false. -/
def whenOk : Bool → (ℕ → Bool × Proof × ℕ) → ℕ → Bool × Proof × ℕ
  | ff, f, n => (false, Proof.sorry, n)
  | tt, f, n => f n
#align tactic.itauto.when_ok Tactic.Itauto.whenOk

/-- The search phase, which deals with the level 3 rules, which are rules that are not validity
preserving and so require proof search. One obvious one is the or-introduction rule: we prove
`A ∨ B` by proving `A` or `B`, and we might have to try one and backtrack.

There are two rules dealing with implication in this category: `p, p → C ⊢ B` where `p` is an
atom (which is safe if we can find it but often requires the right search to expose the `p`
assumption), and `(A₁ → A₂) → C ⊢ B`. We decompose the double implication into two subgoals: one to
prove `A₁ → A₂`, which can be written `A₂ → C, A₁ ⊢ A₂` (where we used `A₁` to simplify
`(A₁ → A₂) → C`), and one to use the consequent, `C ⊢ B`. The search here is that there are
potentially many implications to split like this, and we have to try all of them if we want to be
complete. -/
unsafe def search (prove : context → Prop → ℕ → Bool × Proof × ℕ) :
    context → Prop → ℕ → Bool × Proof × ℕ
  | Γ, B, n =>
    match Γ.find B with
    | some p => (true, p, n)
    | none =>
      let search₁ :=
        Γ.fold none fun A p r =>
          match r with
          | some r => some r
          | none =>
            match A with
            | prop.imp A' C =>
              match Γ.find A' with
              | some q => isOk <| context.with_add (Γ.eraseₓ A) C (p.app q) B prove n
              | none =>
                match A' with
                | prop.imp A₁ A₂ => do
                  let Γ : context := Γ.eraseₓ A
                  let (a, n) := fresh_name n
                  let (p₁, n) ←
                    isOk <|
                        Γ.with_add A₁ (Proof.hyp a) A₂
                          (fun Γ_A₁ A₂ =>
                            Γ_A₁.with_add (Prop.imp A₂ C) (Proof.imp_imp_simp a p) A₂ prove)
                          n
                  is_ok <| Γ C (p (proof.intro a p₁)) B prove n
                | _ => none
            | _ => none
      match search₁ with
      | some r => (true, r)
      | none =>
        match B with
        | prop.or B₁ B₂ =>
          match mapProof Proof.or_inl (prove Γ B₁ n) with
          | (ff, _) => mapProof Proof.or_inr (prove Γ B₂ n)
          | r => r
        | _ => (false, Proof.sorry, n)
#align tactic.itauto.search tactic.itauto.search

/-- The main prover. This receives a context of proven or assumed lemmas and a target proposition,
and returns a proof or `none` (with state for the fresh variable generator).
The intuitionistic logic rules are separated into three groups:

* level 1: No splitting, validity preserving: apply whenever you can.
  Left rules in `context.add`, right rules in `prove`
* level 2: Splitting rules, validity preserving: apply after level 1 rules. Done in `prove`
* level 3: Splitting rules, not validity preserving: apply only if nothing else applies.
  Done in `search`

The level 1 rules on the right of the turnstile are `Γ ⊢ ⊤` and `Γ ⊢ A → B`, these are easy to
handle. The rule `Γ ⊢ A ∧ B` is a level 2 rule, also handled here. If none of these apply, we try
the level 2 rule `A ∨ B ⊢ C` by searching the context and splitting all ors we find. Finally, if
we don't make any more progress, we go to the search phase.
-/
unsafe def prove : context → Prop → ℕ → Bool × Proof × ℕ
  | Γ, prop.true, n => (true, Proof.triv, n)
  | Γ, prop.imp A B, n =>
    let (a, n) := fresh_name n
    mapProof (Proof.intro a) <| Γ.with_add A (Proof.hyp a) B prove n
  | Γ, prop.and' ak A B, n =>
    let (A, B) := ak.sides A B
    let (b, p, n) := prove Γ A n
    mapProof (p.and_intro ak) <| whenOk b (prove Γ B) n
  | Γ, B, n =>
    Γ.fold (fun b Γ => cond b prove (search prove) Γ B)
      (fun A p IH b Γ n =>
        match A with
        | prop.or A₁ A₂ =>
          let Γ : context := Γ.eraseₓ A
          let (a, n) := fresh_name n
          let (b, p₁, n) := Γ.with_add A₁ (Proof.hyp a) B (fun Γ _ => IH true Γ) n
          mapProof (proof.or_elim p a p₁) <|
            whenOk b (Γ.with_add A₂ (Proof.hyp a) B fun Γ _ => IH true Γ) n
        | _ => IH b Γ n)
      false Γ n
#align tactic.itauto.prove tactic.itauto.prove

/-- Reifies an atomic or otherwise unrecognized proposition. If it is defeq to a proposition we
have already allocated, we reuse it, otherwise we name it with a new index. -/
unsafe def reify_atom (atoms : ref (Buffer expr)) (e : expr) : tactic Prop := do
  let vec ← read_ref atoms
  let o ← try_core <| vec.iterate failure fun i e' r => r <|> is_def_eq e e' >> pure i.1
  match o with
    | none => write_ref atoms (vec e) $> prop.var vec
    | some i => pure <| prop.var i
#align tactic.itauto.reify_atom tactic.itauto.reify_atom

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Reify an `expr` into a `prop`, allocating anything non-propositional as an atom in the
      `atoms` list. -/
    unsafe
  def
    reify
    ( atoms : ref ( Buffer expr ) ) : expr → tactic Prop
    | q( True ) => pure Prop.true
      | q( False ) => pure Prop.false
      | q( ¬ $ ( a ) ) => Prop.not <$> reify a
      | q( $ ( a ) ∧ $ ( b ) ) => Prop.and <$> reify a <*> reify b
      | q( $ ( a ) ∨ $ ( b ) ) => Prop.or <$> reify a <*> reify b
      | q( $ ( a ) ↔ $ ( b ) ) => Prop.iff <$> reify a <*> reify b
      | q( Xor' $ ( a ) $ ( b ) ) => Prop.xor <$> reify a <*> reify b
      | q( @ Eq Prop $ ( a ) $ ( b ) ) => Prop.eq <$> reify a <*> reify b
      | q( @ Ne Prop $ ( a ) $ ( b ) ) => Prop.not <$> ( Prop.eq <$> reify a <*> reify b )
      | q( Implies $ ( a ) $ ( b ) ) => Prop.imp <$> reify a <*> reify b
      |
        e @ q( $ ( a ) → $ ( b ) )
        =>
        if b . has_var then reify_atom atoms e else Prop.imp <$> reify a <*> reify b
      | e => reify_atom atoms e
#align tactic.itauto.reify tactic.itauto.reify

/-- Once we have a proof object, we have to apply it to the goal. (Some of these cases are a bit
annoying because `applyc` gets the arguments wrong sometimes so we have to use `to_expr` instead.)
-/
unsafe def apply_proof : name_map expr → Proof → tactic Unit
  | Γ, proof.sorry => fail "itauto failed"
  | Γ, proof.hyp n => do
    let e ← Γ.find n
    exact e
  | Γ, proof.triv => triv
  | Γ, proof.exfalso' p => do
    let t ← mk_mvar
    to_expr ``(False.elim $(t)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t :: gs)
    apply_proof Γ p
  | Γ, proof.intro x p => do
    let e ← intro_core x
    apply_proof (Γ x e) p
  | Γ, proof.and_left and_kind.and p => do
    let t ← mk_mvar
    to_expr ``(And.left $(t)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t :: gs)
    apply_proof Γ p
  | Γ, proof.and_left and_kind.iff p => do
    let t ← mk_mvar
    to_expr ``(Iff.mp $(t)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t :: gs)
    apply_proof Γ p
  | Γ, proof.and_left and_kind.eq p => do
    let t ← mk_mvar
    to_expr ``(cast $(t)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t :: gs)
    apply_proof Γ p
  | Γ, proof.and_right and_kind.and p => do
    let t ← mk_mvar
    to_expr ``(And.right $(t)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t :: gs)
    apply_proof Γ p
  | Γ, proof.and_right and_kind.iff p => do
    let t ← mk_mvar
    to_expr ``(Iff.mpr $(t)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t :: gs)
    apply_proof Γ p
  | Γ, proof.and_right and_kind.eq p => do
    let t ← mk_mvar
    to_expr ``(cast (Eq.symm $(t))) tt ff >>= exact
    let gs ← get_goals
    set_goals (t :: gs)
    apply_proof Γ p
  | Γ, proof.and_intro and_kind.and p q => do
    let t₁ ← mk_mvar
    let t₂ ← mk_mvar
    to_expr ``(And.intro $(t₁) $(t₂)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t₁ :: t₂ :: gs)
    apply_proof Γ p >> apply_proof Γ q
  | Γ, proof.and_intro and_kind.iff p q => do
    let t₁ ← mk_mvar
    let t₂ ← mk_mvar
    to_expr ``(Iff.intro $(t₁) $(t₂)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t₁ :: t₂ :: gs)
    apply_proof Γ p >> apply_proof Γ q
  | Γ, proof.and_intro and_kind.eq p q => do
    let t₁ ← mk_mvar
    let t₂ ← mk_mvar
    to_expr ``(propext (Iff.intro $(t₁) $(t₂))) tt ff >>= exact
    let gs ← get_goals
    set_goals (t₁ :: t₂ :: gs)
    apply_proof Γ p >> apply_proof Γ q
  | Γ, proof.curry ak p => do
    let e ← intro_core `_
    let n := e.local_uniq_name
    apply_proof (Γ n e) (proof.curry₂ ak p (proof.hyp n))
  | Γ, proof.curry₂ ak p q => do
    let e ← intro_core `_
    let n := e.local_uniq_name
    apply_proof (Γ n e) (p (q ak (proof.hyp n)))
  | Γ, proof.app' p q => do
    let A ← mk_meta_var (expr.sort level.zero)
    let B ← mk_meta_var (expr.sort level.zero)
    let g₁ ← mk_meta_var q(($(A) : Prop) → ($(B) : Prop))
    let g₂ ← mk_meta_var A
    let g :: gs ← get_goals
    unify (g₁ g₂) g
    (set_goals (g₁ :: g₂ :: gs) >> apply_proof Γ p) >> apply_proof Γ q
  | Γ, proof.or_imp_left p => do
    let e ← intro_core `_
    let n := e.local_uniq_name
    apply_proof (Γ n e) (p (proof.hyp n).or_inl)
  | Γ, proof.or_imp_right p => do
    let e ← intro_core `_
    let n := e.local_uniq_name
    apply_proof (Γ n e) (p (proof.hyp n).or_inr)
  | Γ, proof.or_inl p => do
    let t ← mk_mvar
    to_expr ``(Or.inl $(t)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t :: gs)
    apply_proof Γ p
  | Γ, proof.or_inr p => do
    let t ← mk_mvar
    to_expr ``(Or.inr $(t)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t :: gs)
    apply_proof Γ p
  | Γ, proof.or_elim' p x p₁ p₂ => do
    let t₁ ← mk_mvar
    let t₂ ← mk_mvar
    let t₃ ← mk_mvar
    to_expr ``(Or.elim $(t₁) $(t₂) $(t₃)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t₁ :: t₂ :: t₃ :: gs)
    apply_proof Γ p
    let e ← intro_core x
    apply_proof (Γ x e) p₁
    let e ← intro_core x
    apply_proof (Γ x e) p₂
  | Γ, proof.em ff n => do
    let e ← Γ.find n
    to_expr ``(@Decidable.em _ $(e)) >>= exact
  | Γ, proof.em tt n => do
    let e ← Γ.find n
    to_expr ``(@Classical.em $(e)) >>= exact
  | Γ, proof.decidable_elim ff n x p₁ p₂ => do
    let e ← Γ.find n
    let t₁ ← mk_mvar
    let t₂ ← mk_mvar
    to_expr ``(@dite _ _ $(e) $(t₁) $(t₂)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t₁ :: t₂ :: gs)
    let e ← intro_core x
    apply_proof (Γ x e) p₁
    let e ← intro_core x
    apply_proof (Γ x e) p₂
  | Γ, proof.decidable_elim tt n x p₁ p₂ => do
    let e ← Γ.find n
    let e ← to_expr ``(@Classical.dec $(e))
    let t₁ ← mk_mvar
    let t₂ ← mk_mvar
    to_expr ``(@dite _ _ $(e) $(t₁) $(t₂)) tt ff >>= exact
    let gs ← get_goals
    set_goals (t₁ :: t₂ :: gs)
    let e ← intro_core x
    apply_proof (Γ x e) p₁
    let e ← intro_core x
    apply_proof (Γ x e) p₂
  | Γ, proof.imp_imp_simp x p => do
    let e ← intro_core `_
    let n := e.local_uniq_name
    apply_proof (Γ n e) (p (proof.intro x (proof.hyp n)))
#align tactic.itauto.apply_proof tactic.itauto.apply_proof

end Itauto

open Itauto

/-- A decision procedure for intuitionistic propositional logic.

* `use_dec` will add `a ∨ ¬ a` to the context for every decidable atomic proposition `a`.
* `use_classical` will allow `a ∨ ¬ a` to be added even if the proposition is not decidable,
  using classical logic.
* `extra_dec` will add `a ∨ ¬ a` to the context for specified (not necessarily atomic)
  propositions `a`.
-/
unsafe def itauto (use_dec use_classical : Bool) (extra_dec : List expr) : tactic Unit :=
  using_new_ref mkBuffer fun atoms =>
    using_new_ref mk_name_map fun hs => do
      let t ← target
      let t ← condM (is_prop t) (reify atoms t) (tactic.exfalso $> Prop.false)
      let hyps ← local_context
      let (Γ, decs) ←
        hyps.foldlM
            (fun (Γ : Except (Prop → Proof) context × native.rb_map Prop (Bool × expr)) h => do
              let e ← infer_type h
              condM (is_prop e)
                  (do
                    let A ← reify atoms e
                    let n := h
                    read_ref hs >>= fun Γ => write_ref hs (Γ n h)
                    pure (Γ.1 >>= fun Γ' => Γ' A (proof.hyp n), Γ.2))
                  (match e with
                  | q(Decidable $(p)) =>
                    if use_dec then do
                      let A ← reify atoms p
                      let n := h
                      pure (Γ.1, Γ.2.insert A (ff, h))
                    else pure Γ
                  | _ => pure Γ))
            (Except.ok native.mk_rb_map, native.mk_rb_map)
      let add_dec (force : Bool) (decs : native.rb_map Prop (Bool × expr)) (e : expr) := do
        let A ← reify atoms e
        let dec_e ← mk_app `` Decidable [e]
        let res ← try_core (mk_instance dec_e)
        if res ∧ ¬use_classical then
            if force then do
              let m ← mk_meta_var dec_e
              (set_goals [m] >> apply_instance) >> failure
            else pure decs
          else pure (native.rb_map.insert decs A (res (tt, e) (Prod.mk ff)))
      let decs ← extra_dec.foldlM (add_dec true) decs
      let decs ←
        if use_dec then do
            let decided :=
              match Γ with
              | Except.ok Γ =>
                Γ.fold native.mk_rb_set fun p _ m =>
                  match p with
                  | prop.var i => m.insert i
                  | prop.not (prop.var i) => m.insert i
                  | _ => m
              | Except.error _ => native.mk_rb_set
            read_ref atoms >>= fun ats =>
                ats.2.iterate (pure decs) fun i e r =>
                  if decided i.1 then r else r >>= fun decs => add_dec ff decs e
          else pure decs
      let Γ ←
        decs.fold (pure Γ) fun A ⟨cl, pf⟩ r =>
            r >>= fun Γ => do
              let n ← mk_fresh_name
              read_ref hs >>= fun Γ => write_ref hs (Γ n pf)
              pure (Γ >>= fun Γ' => Γ' (A A) (proof.em cl n))
      let p :=
        match Γ with
        | Except.ok Γ => (prove Γ t 0).2.1
        | Except.error p => p t
      let hs ← read_ref hs
      apply_proof hs p
#align tactic.itauto tactic.itauto

namespace Interactive

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- A decision procedure for intuitionistic propositional logic. Unlike `finish` and `tauto!` this
tactic never uses the law of excluded middle (without the `!` option), and the proof search is
tailored for this use case. (`itauto!` will work as a classical SAT solver, but the algorithm is
not very good in this situation.)

```lean
example (p : Prop) : ¬ (p ↔ ¬ p) := by itauto
```

`itauto [a, b]` will additionally attempt case analysis on `a` and `b` assuming that it can derive
`decidable a` and `decidable b`. `itauto *` will case on all decidable propositions that it can
find among the atomic propositions, and `itauto! *` will case on all propositional atoms.
*Warning:* This can blow up the proof search, so it should be used sparingly.
-/
unsafe def itauto (classical : parse (parser.optional (tk "!"))) :
    parse (parser.optional (some <$> pexpr_list <|> tk "*" *> pure none)) → tactic Unit
  | none => tactic.itauto False classical.isSome []
  | some none => tactic.itauto True classical.isSome []
  | some (some ls) => ls.mapM i_to_expr >>= tactic.itauto False classical.isSome
#align tactic.interactive.itauto tactic.interactive.itauto

add_hint_tactic itauto

add_tactic_doc
  { Name := "itauto"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.itauto]
    tags := ["logic", "propositional logic", "intuitionistic logic", "decision procedure"] }

end Interactive

end Tactic


import .neutralplane
open_locale classical
noncomputable theory

open IncidencePlane NeutralPlane

-- Exercises
variables {Ω : Type*} [NeutralPlane Ω]

lemma distance_eq (A : Ω) : distance A A = 0 :=
begin
	rw ruler_dist,
	simp only [sub_self, abs_zero],
end

lemma line_through_symm (P Q : Ω) : line_through P Q = line_through Q P :=
begin
	by_cases hPQ : Q = P,
	{
		subst hPQ,
	},
	{
		exact IncidencePlane.incidence hPQ (line_through_right P Q) (line_through_left P Q),
	}
end

lemma distance_symm (A B : Ω) : distance A B = distance B A :=
begin
	rw ruler_dist,
	rw ruler_dist,
	rw line_through_symm,
	rw abs_sub_comm,
end

lemma distance_nonneg (A B : Ω) : 0 ≤ distance A B :=
begin
	rw ruler_dist,
	apply abs_nonneg,
end

lemma distance_nondegenerate (A B : Ω) : distance A B = 0 ↔ A = B :=
begin
	split,
	{
		intro h,
		rw ruler_dist at h,
		set ℓ := line_through A B,
		have h' : ruler ℓ A = ruler ℓ B := eq_of_abs_sub_eq_zero h,
		apply ruler_inj (line_through_left A B) (line_through_right A B) h',
	},
	{
		intro h,
		subst h,
		rw ruler_dist,
		simp only [sub_self, abs_zero],
	}
end

lemma between_swap' (A B C : Ω) : (A * B * C) → (C * B * A) :=
begin
	intro h,
	cases h,
	split,
	{
		rw collinear_of_equal ({A, B, C} : set Ω) ({C, B, A} : set Ω) at h_left,
		exact h_left,
	},
	{
		rw [show distance A C = distance C A, by rw distance_symm] at h_right,
		rw ←h_right,
		rw [show distance C B = distance B C, by rw distance_symm],
		rw [show distance B A = distance A B, by rw distance_symm],
		rw add_comm,
	},
end

lemma between_swap (A B C : Ω) : (A * B * C) ↔ (C * B * A) :=
begin
	split; apply between_swap',
end

@[simp] lemma  between_trivial (A B : Ω) : A * B * B :=
begin
	unfold between,
	split,
	{
		use line_through A B,
		simp,
		exact ⟨line_through_left A B, line_through_right A B⟩
	},
	{
		rw distance_eq,
		exact add_zero (distance A B)
	}
end

@[simp] lemma  between_trivial' (A B : Ω) : A * A * B :=
begin
	rw between_swap,
	exact between_trivial B A,
end

lemma segment_eq (A B : Ω) : A⬝B ≈ B⬝A :=
begin
	simp,
	intro t,
	split;
	{
		intro h,
		rw between_swap,
		tauto,
	},
end

-- We skip the ruler placement postulate. We'll see whether it's needed or not...

meta def linarith' := `[linarith]
lemma abs_sub_of_le (x y : ℝ) (h: x ≤ y . linarith') : |x - y| = y - x :=
begin
	rw abs_of_nonpos (sub_nonpos.mpr h),
	exact neg_sub x y,
end
lemma abs_sub_of_le' (x y : ℝ) (h: y ≤ x . linarith') : |x - y| = x - y :=
begin
	rw abs_of_nonneg (sub_nonneg.mpr h),
end

lemma ruler_dist' (ℓ : Line Ω) {P Q : Ω} (hP : P ∈ ℓ) (hQ : Q ∈ ℓ) : distance P Q = |ruler ℓ P - ruler ℓ Q| :=
begin
	by_cases P = Q,
	{
		rw [h, distance_eq],
		simp only [sub_self, abs_zero],
	},
	{
		rw [incidence h hP hQ, ruler_dist],
	}
end

lemma between_iff_aux (A B C : Ω) : (A * B * C) → C * B * A :=
begin
	intro h,
	split,
	{
		rw collinear_of_equal ({C, B, A} : set Ω) {A, B, C},
		exact h.1,
	},
	{
		cases h,
		rw distance_symm C B,
		rw distance_symm B A,
		rw distance_symm C A,
		rw ←h_right,
		ring,
	}
end

lemma between_iff (A B C : Ω) : (A * B * C) ↔ C * B * A :=
begin
	split; apply between_iff_aux,
end

lemma between_ruler_aux {A B C : Ω} (ℓ : Line Ω) (hA : A ∈ ℓ) (hB : B ∈ ℓ) (hC : C ∈ ℓ) :
ruler ℓ A ≤ ruler ℓ B ∧ ruler ℓ B ≤ ruler ℓ C → A * B * C :=
begin
	intro h,
	cases h,
	{
		unfold between,
		rw [ruler_dist' ℓ hA hB, ruler_dist' ℓ hB hC, ruler_dist' ℓ hA hC],
		split,
		{
			use ℓ,
			finish,
		},
		repeat {rw abs_sub_of_le},
		ring,
	},
end

lemma between_ruler (A B C : Ω) (ℓ : Line Ω) (hA : A ∈ ℓ) (hB : B ∈ ℓ) (hC : C ∈ ℓ) :
(A * B * C) ↔ ruler ℓ A ≤ ruler ℓ B ∧ ruler ℓ B ≤ ruler ℓ C ∨ ruler ℓ C ≤ ruler ℓ B ∧ ruler ℓ B ≤ ruler ℓ A :=
begin
	split,
	{
		intro h,
		cases h,
		set α := ruler ℓ,
		by_cases H : α A ≤ α B ∧ α B ≤ α C, tauto,
		right,
		rw [ruler_dist' ℓ hA hB, ruler_dist' ℓ hB hC, ruler_dist' ℓ hA hC] at h_right,
		rw [show ruler ℓ = α, by refl] at h_right,
		replace H : α B < α A ∨ α C < α B,
		{
			push_neg at H,
			by_cases hc : α A ≤ α B,
			{
				specialize H hc,
				right, exact H,
			},
			{
				left,
				linarith,
			}
		},
		cases H,
		{
			split,
			{
				by_contradiction hc,
				replace hc : α B < α C, by linarith,
				rw abs_sub_of_le' at h_right,
				rw abs_sub_of_le at h_right,
				by_cases h1 : α A ≤ α C,
				{
					rw abs_sub_of_le at h_right,
					linarith,
				},
				{
					rw abs_sub_of_le' at h_right,
					linarith,
				}
			},
			exact le_of_lt H,
		},
		{
			split,
			exact le_of_lt H,
			by_contradiction hc,
			replace hc : α A < α B, by linarith,
			rw abs_sub_of_le at h_right,
			rw abs_sub_of_le' at h_right,
			by_cases h1 : α A ≤ α C,
			{
				rw abs_sub_of_le at h_right,
				linarith,
			},
			{
				rw abs_sub_of_le' at h_right,
				linarith,
			}
		}
	},
	{
		intro h,
		cases h,
		{
			apply between_ruler_aux ℓ; assumption,
		},
		{
			rw between_iff,
			apply between_ruler_aux ℓ; assumption,
		}
	}
end

def is_midpoint (P Q M : Ω) := (P * M * Q) ∧ distance P M = distance M Q

lemma midpoint_exists_unique (P Q : Ω) : ∃! M, is_midpoint P Q M :=
begin
	by_cases P = Q,
	{
		use P,
		rw ← h,
		split,
		{
			split,
			{
				exact between_trivial P P,
			},
			{
				refl,
			}
		},
		{
			intros M hM,
			rcases hM with ⟨⟨H1, H2⟩, h2⟩,
			have H : distance M P = 0,
			{
				rwa [h2, distance_eq P, add_self_eq_zero] at H2,
			},
			exact (distance_nondegenerate M P).1 H,
		},
	},
	{
		sorry
	}
end

lemma point_construction (r : Ray Ω) (h : ¬ r.degenerate) (d : ℝ) (hd : 0 ≤ d) :
∃! Q, Q ∈ pts r ∧ distance r.origin Q = d :=
begin
	sorry
end

lemma pasch {T : Triangle Ω} {ℓ : Line Ω} (hT : ¬ T.degenerate) (hℓ : pts ℓ ∩ T.vertices.to_finset ∩ ℓ = ∅)
(h : (pts ℓ ∩ T.A⬝T.B).nonempty) : (pts ℓ ∩ T.B⬝T.C).nonempty ∨ (pts ℓ ∩ T.A⬝T.C).nonempty :=
begin
	sorry
end

lemma isosceles_triangle (T : Triangle Ω) (h : (T.A⬝T.B) ≅ (T.A⬝T.C)) :
(∟ T.A T.B T.C) ≅ (∟ T.A T.C T.B) :=
begin
	set S1 := ▵ T.B T.A T.C,
	set S2 := ▵ T.C T.A T.B,
	simp at h,
	have h1 : (T.B⬝T.A) ≅ (T.C⬝T.A),
	{
		simp,
		rw distance_symm,
		rw h,
		exact distance_symm T.A T.C,
	},
	have h2 : (T.A⬝T.C) ≅ (T.A⬝T.B),
	{
		simp,
		rw distance_symm,
		rw h,
		exact distance_symm T.C T.A,
	},
	have h3 : (∟ T.C T.A T.B) ≅ (∟ T.B T.A T.C),
	{
		apply angle_well_def,
		unfold has_equiv.equiv,
		simp,
	},
	have := (NeutralPlane.SAS S1 S2 h1 h2 h3).2,
	simpa using this.1,
end

-- Theorem 3.3.9
lemma ray_theorem {ℓ : Line Ω} {A B C : Ω} (hA : A ∈ ℓ) (hB : B ∉ ℓ) (hC : C ∈ pts(A=>B)) (hAC : C ≠ A) :
same_side ℓ B C :=
begin
	sorry
end

-- Theorem 3.3.10
lemma point_between_iff_ray_between {A B C D : Ω} (h : ¬ collinear ({A, B, C} : set Ω)) (hD : D ∈ line_through B C)
: (B * D * C) ↔ Ray.between (A=>B) (A=>D) (A=>C)  :=
begin
	sorry
end

lemma same_side.trans (ℓ : Line Ω) {A B C : Ω} : same_side ℓ A B → same_side ℓ B C → same_side ℓ A C :=
begin
	sorry
end

-- Lemma 3.4.4
lemma ray_betweenness_aux (A B C D : Ω) (hAB : A ≠ B) (h : same_side (line_through A B) C D)
(h' : ¬ D ∈ line_through A C) : C ∈ (∟ B A D).interior ∨ D ∈ (∟ B A C).interior :=
begin
sorry
end

-- Theorem 3.4.5
theorem Ray.between_of_le_measure (A B C D : Ω) (hAB : A ≠ B) (h : same_side (line_through A B) C D) : (∟ B A D).m ≤ (∟ B A C).m ↔ Ray.between (A=>B) (A=>D) (A=>C) :=
begin
sorry
end

-- Theorem 3.5.1
lemma Z_theorem (A D B E: Ω) (hAB : A ≠ D) (h : ¬ same_side (line_through A D) B E) :
(A=>B : set Ω) ∩ D=>E = ∅ :=
begin
sorry
end

theorem crossbar (A B C D : Ω) (h : D ∈ (∟ B A C).interior) :
∃ G : Ω, G ∈ A=>D ∧ G ∈ B⬝C :=
begin
sorry
end

-- Lemma 3.5.1
lemma Angle.interior_of_between {A B C D E : Ω} (D : Ω) (h : C * A * B) (h' : D ∈ (∟ B A E).interior) :
E ∈ (∟ D A C).interior :=
begin
sorry
end

lemma Angle.supplement_of_linear_pair (α β : Angle Ω) :
α.linear_pair β → α.supplementary β :=
begin
sorry
end

-- TOWARDS PROVING PYTHAGORAS' THEOREM

lemma perpendicular_through (ℓ : Line Ω) (P : Ω) (h : P ∉ ℓ): ∃ Q,
Q ∈ ℓ ∧ (line_through P Q) ⊥ ℓ :=
begin
sorry
end

def perpendicular_foot (ℓ : Line Ω) (P : Ω) (h : P ∉ ℓ) : Ω := Exists.some $ perpendicular_through ℓ P h

-- Lemma 4.8.6
lemma perpendicular_between (A B C : Ω) (h0 : C ∉ line_through A B) (h : (∟ C A B).is_acute) (h' : (∟ A B C).is_acute)
: A * (perpendicular_foot (line_through A B) C h0) * B :=
begin
sorry
end


import algebra.field
import gtm106.weierstrass_equation.basic
import gtm106.weierstrass_equation.linear_change_of_variable.basic
import tactic

namespace linear_change_of_variable

-- ================
-- Linear change of variables act on Weierstrass equations
-- ================

def change_curve {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K) : weierstrass_equation K :=
⟨ ((E.a1 + 2*C.s)/C.u),
  ((E.a2 - C.s*E.a1 + 3*C.r - C.s^2)/C.u^2),
  ((E.a3 + C.r*E.a1 + 2*C.t)/C.u^3),
  ((E.a4 - C.s*E.a3 + 2*C.r*E.a2 - (C.t+C.r*C.s)*E.a1 + 3*C.r^2 - 2*C.s*C.t)/C.u^4),
  ((E.a6 + C.r*E.a4 + C.r^2*E.a2 + C.r^3 - C.t*E.a3 - C.t^2 - C.r*C.t*E.a1)/C.u^6) ⟩

namespace change_curve

@[simp]
lemma id {K : Type*} [field K]
(E : weierstrass_equation K) :
(identity K).change_curve E = E :=
begin
  simp [weierstrass_equation.ext_iff, identity, change_curve, zero_pow],
end

lemma comp {K : Type*} [field K]
(C C' : linear_change_of_variable K) (E : weierstrass_equation K) :
(C'.composite C).change_curve E = C'.change_curve (C.change_curve E) :=
begin
  simp [weierstrass_equation.ext_iff, composite, change_curve],
  split, { field_simp, ring, },
  split, { field_simp, ring, },
  split, { field_simp, ring, },
  split, { field_simp, ring, },
  field_simp, ring,
end

instance to_has_scalar (K : Type*) [h : field K]
: has_scalar (linear_change_of_variable K) (weierstrass_equation K)
:= ⟨ change_curve ⟩

instance to_mul_action (K : Type*) [h : field K]
: mul_action (linear_change_of_variable K) (weierstrass_equation K)
:= ⟨ @id K h, by {
  intros _ _ _, simp only [has_mul.mul, has_scalar.smul,
    mul_one_class.mul, monoid.mul, div_inv_monoid.mul, group.mul, comp],
} ⟩

end change_curve

-- ================
-- Change of invariants under linear change of variables
-- ================

@[simp]
lemma a1 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).a1 = (E.a1 + 2*C.s)/C.u :=
begin
  simp [change_curve],
end

@[simp]
lemma a2 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).a2 = (E.a2 - C.s*E.a1 + 3*C.r - C.s^2)/C.u^2 :=
begin
  simp [change_curve],
end

@[simp]
lemma a3 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).a3 = (E.a3 + C.r*E.a1 + 2*C.t)/C.u^3 :=
begin
  simp [change_curve],
end

@[simp]
lemma a4 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).a4 = (E.a4 - C.s*E.a3 + 2*C.r*E.a2 - (C.t+C.r*C.s)*E.a1 + 3*C.r^2 - 2*C.s*C.t)/C.u^4 :=
begin
  simp [change_curve],
end

@[simp]
lemma a6 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).a6 = (E.a6 + C.r*E.a4 + C.r^2*E.a2 + C.r^3 - C.t*E.a3 - C.t^2 - C.r*C.t*E.a1)/C.u^6 :=
begin
  simp [change_curve],
end

@[simp]
lemma b2 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).b2 = (E.b2 + 12*C.r)/C.u^2 :=
begin
  simp [weierstrass_equation.b2],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma b4 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).b4 = (E.b4 + C.r*E.b2 + 6*C.r^2)/C.u^4 :=
begin
  simp [weierstrass_equation.b4, weierstrass_equation.b2],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma b6 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).b6 = (E.b6 + 2*C.r*E.b4 + C.r^2*E.b2 + 4*C.r^3)/C.u^6 :=
begin
  simp [weierstrass_equation.b6, weierstrass_equation.b4, weierstrass_equation.b2],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma b8 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).b8 = (E.b8 + 3*C.r*E.b6 + 3*C.r^2*E.b4 + C.r^3*E.b2 + 3*C.r^4)/C.u^8 :=
begin
  simp [weierstrass_equation.b8, weierstrass_equation.b6,
    weierstrass_equation.b4, weierstrass_equation.b2],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma c4 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).c4 = E.c4/C.u^4 :=
begin
  simp [weierstrass_equation.c4],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma c6 {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).c6 = E.c6/C.u^6 :=
begin
  simp [weierstrass_equation.c6],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma disc {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).disc = E.disc/C.u^12 :=
begin
  simp [weierstrass_equation.disc],
  simp [weierstrass_equation.b8, weierstrass_equation.b6,
    weierstrass_equation.b4, weierstrass_equation.b2],
  field_simp [pow_succ],
  ring,
end

@[simp]
lemma j {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: (C.change_curve E).j = E.j :=
begin
  simp [weierstrass_equation.j],
  by_cases h : E.disc = 0, {
    simp [h],
  },
  field_simp [pow_succ, h],
  ring,
end

lemma preserve_non_singular' {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: E.non_singular' ↔ (C.change_curve E).non_singular' :=
begin
  simp [weierstrass_equation.non_singular', hu],
end

lemma preserve_has_node' {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: E.has_node' ↔ (C.change_curve E).has_node' :=
begin
  simp [weierstrass_equation.has_node'],
end

lemma preserve_has_cusp' {K : Type*} [field K]
(C : linear_change_of_variable K) (E : weierstrass_equation K)
: E.has_cusp' ↔ (C.change_curve E).has_cusp' :=
begin
  simp [weierstrass_equation.has_cusp'],
end

end linear_change_of_variable


import Lake
import Init
import Mathlib.Data.Real.Basic

#eval 1

def And_implies_right (a b : Prop): a ∧ b → a := by
  intro hab
  apply And.left hab

/-def Distrubutive (a b c : Prop): a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) := by
  apply Iff.intro
  case mp =>
    intro h
    have ha : a := And.left h
    have hborc : b ∨ c := And.right h
    by_cases hc:c
    case inl =>
      have hac : a ∧ c := by apply And.intro ha hc
      apply Or.inr
      assumption
    case inr =>
        by_cases hb : b
        case inl =>
          have hab : a ∧ b := by apply And.intro ha hb
          apply Or.inl
          assumption
        case inr =>-/

theorem FO (A : Type) : ∀ x : A, ∃ y : A , x = y := by
  intro x'
  have lem1 : x' = x' := rfl

def divides (x y : Nat) : Prop :=
  ∃ k, k*x = y

def divides_trans (h₁ : divides x y) (h₂ : divides y z) : divides x z :=
  let ⟨k₁, d₁⟩ := h₁
  let ⟨k₂, d₂⟩ := h₂
  ⟨k₁ * k₂, by rw [Nat.mul_comm k₁ k₂, Nat.mul_assoc, d₁, d₂]⟩

-------------------------------------------------------------------------------
axiom Point : Type
-- variable [pts_nonEmpty : Inhabited Point]

axiom Line : Type
axiom lies_on : Point → Line → Prop

axiom congruence : {A : Type} → A → A →  Prop

-- Congruence is equivalence relationship

axiom CongEquiv {A : Type} : IsEquiv A congruence

lemma CongRefl {A : Type} : ∀ a : A, congruence a a :=
  CongEquiv.refl

lemma CongSymm {A : Type} :
  ∀ a b : A, congruence a b → congruence b a :=
  CongEquiv.symm

lemma CongTrans {A : Type} :
  ∀ a b c : A,
    congruence a b → congruence b c → congruence a c :=
  CongEquiv.trans

axiom in_between : Point → Point → Point → Prop

structure Segment : Type :=
  p1 : Point
  p2 : Point

axiom distance (Apt Bpt : Point) : ℝ

-- Distance axioms
axiom dist_is_not_neg (A B : Point): distance A B ≥ 0
axiom dist_same_point (A : Point) : distance A A = 0
axiom dist_geq_0 (A B : Point) : A ≠ B ↔ distance A B >  0
axiom dist_is_symm (A B : Point) : distance A B = distance B A
axiom dist_tri_ineq (A B C : Point) :
distance A B + distance B C ≥ distance A C

-- Axioms when a point is in between other two
axiom dist_in_between (a b c : Point) (h : in_between a b c) :
distance a b + distance b c = distance a c

axiom between_refl_left (a b : Point) : in_between a a b
axiom between_refl_right (a b : Point) : in_between a b b

--Euclid postulates

--Postulate 1
--Between two points there is an unique line passing through them
axiom Line_of_two_points (A B : Point) (h : A ≠ B): Line --says you get a line from two points
axiom point_contain (A B : Point) (h : A ≠ B) : --says such a line contain both the points
  have l : Line := Line_of_two_points A B h
  lies_on A l ∧ lies_on B l

axiom line_unique (A B: Point) (h : A ≠ B) (l1 l2 : Line): --says such a line is unique
  (lies_on A l1 ∧ lies_on B l1) ∧ (lies_on A l2 ∧ lies_on B l2) → l1 = l2

axiom IsCoincide (l1 l2 : Line) : l1 = l2

--Postulate 2
--A line segment can be extended to get a line
axiom line_from_seg (seg : Segment) : Line --says a you get a line from a segment
axiom contain_end_points (seg : Segment) : --says the end points of the segment lies on the resulting line
  lies_on (seg.p1) (line_from_seg seg) ∧ lies_on (seg.p2) (line_from_seg seg)
/-
theorem line_from_seg_unique (S : Segment) :
let l₁ := line_from_seg S
let l₂ := line_from_seg S
l₁ = l₂ := rfl
  --have lem1 : lies_on S.p1 l₁ ∧ lies_on S.p2 l₂ := contain_end_points S-/

axiom length_of_seg (seg : Segment) : ℝ
axiom Length_of_seg (seg : Segment) : length_of_seg seg = distance seg.p1 seg.p2

--Postulate 3
--A circle can be drawn from any centre and any radius
structure Circle : Type :=
  centre : Point
  radius : ℝ

axiom On_circle (A : Point) (C : Circle) :
distance C.centre A = C.radius

/-
def Equi_triangle (A B C : Point) : Prop :=
distance A B = distance A C ∧ distance A C = distance B C

theorem Elements_th1 (s : Segment) :
∃ C : Point , Equi_triangle (s.p1 s.p2 C) := by
  have c1 : Circle := Circle.mk s.p1 (length_of_seg s)
  have c2 : Circle := Circle.mk s.p2 (length_of_seg s)

-/

--- (c1 : Circle) : c1.centre = segAB.p1 ∧ c1.radius = (distance (segAB.p1 segAB.p2)) →

--Postulate 4
--All right angles are equal
structure Angle : Type :=
  p1 : Point
  Pivot : Point
  p2 : Point
-- check whether p1 and pivot are different points
axiom reflexAngle : Angle → Angle

axiom mAngle : Angle → ℝ

axiom CompleteAngle (A : Angle): mAngle (reflexAngle A) = 360 - mAngle A

-- properties of Angle
axiom AngleSymm (a b c : Point) : Angle.mk a b c  = Angle.mk c b a

axiom MakingIntPointAngle (a : Point) (A : Angle) : Prop

-- property of "introducing an interior point 'a' within an angle A"
def IntPointAngle (a : Point) (A : Angle) (_ : MakingIntPointAngle a A): Prop :=
  have A1 : Angle := Angle.mk a A.Pivot A.p1
  have A2 : Angle := Angle.mk a A.Pivot A.p2
  (mAngle (A1) < mAngle  A)
  ∧ (mAngle (A2) < mAngle A) -- strict inequality because of 120

#check IntPointAngle
-- properties of mAngle

axiom mAngle_non_neg (a b c : Point) : mAngle (Angle.mk a b c) ≥ 0
axiom ZeroAngle (a b c : Point) (hc : in_between a c b): mAngle (Angle.mk a b c) = 0
axiom mAngle_postive (a b c : Point) (hc : ¬ in_between a c b) (ha : ¬ in_between c a b):
  mAngle (Angle.mk a b c) > 0

axiom mReflexAngle (A : Angle) : mAngle (reflexAngle A) = 360 - mAngle A

-- Angle A as Sum of its constituents
axiom mAngleAdd (a : Point) (A : Angle) (hInt : MakingIntPointAngle a A)(h : IntPointAngle a A hInt) :
  have A1 : Angle := Angle.mk a A.Pivot A.p1
  have A2 : Angle := Angle.mk a A.Pivot A.p2
  mAngle A = mAngle A1 + mAngle A2

-- Given Angle A, if we introduce segment (a A.Pivot), then
-- the constiuents sum to the whole Angle A. We can obtain the
-- this as a theorem to MakingIntPointAngle, IntPointAngle, mAngleAdd.

-- Postulate 4 says all right angles are equal.
-- We are assigning it a value of 90
axiom isRightAngle (A : Angle): mAngle A = 90
-- straight line is two right angles
axiom StraightAngle (a b c : Point) (h : in_between a b c) : mAngle (Angle.mk a b c) = 180

axiom IsParallel : Line → Line → Prop -- defn of parallel lines
--axiom notPara_Intersect (l1 l2 : Line): IsParallel l1 l2 →
--∃ c : Point, lies_on c l1 ∧ lies_on c l2 → False

axiom ParaEquiv : IsEquiv Line IsParallel

def somefunc : Nat → Nat → Nat := fun n m ↦ n*m

#eval somefunc 2 3
#check somefunc

lemma Pararefl : ∀ l : Line, IsParallel l l :=
  ParaEquiv.refl

lemma ParaSymm :
  ∀ l₁ l₂ : Line,
    IsParallel l₁ l₂ → IsParallel l₂ l₁ :=
      ParaEquiv.symm

lemma ParaTrans :
  ∀ l₁ l₂ l₃ : Line,
    IsParallel l₁ l₂ → IsParallel l₂ l₃ → IsParallel l₁ l₃ :=
      ParaEquiv.trans

-- need to take care of the case when l1 = l2 for IsIntersect.
-- we probably don't need this

-- property of IsIntersect
axiom Intersect_common_point (l1 l2 : Line) (h : ¬ IsParallel l1 l2) :
  ∃ c : Point, lies_on c l1 ∧ lies_on c l2

-- Unique intersection point of two lines
theorem UniqueIntersectPoint (l1 l2 : Line) (h : ¬ IsParallel l1 l2) :
  lies_on (a : Point) l1 ∧ lies_on a l2
  →
  lies_on  (b : Point) l1 ∧ lies_on b l2
  →
  a ≠ b →
  False := by
    intro h1 h2 hab
    have h1l : lies_on a l1 := And.left h1
    have h1r : lies_on a l2 := And.right h1
    have h2l : lies_on b l1 := And.left h2
    have h2r : lies_on b l2 := And.right h2
    let lab := Line_of_two_points a b hab
    have lemlab : lies_on a lab ∧ lies_on b lab := point_contain a b hab
    have lem1 : l1 = lab := by
      apply line_unique a b hab
      apply And.intro
      case a.left =>
        apply And.intro
        case left => assumption
        case right => assumption
      case a.right =>
        assumption
    have lem2 : l2 = lab := by
      apply line_unique a b hab
      apply And.intro
      case a.left =>
        apply And.intro
        case left => assumption
        case right => assumption
      case a.right =>
        assumption
    have lem3 : IsParallel l1 lab := by
      rw [lem1]
      apply Pararefl
    have lem4 : IsParallel lab l2 := by
      rw [lem2]
      apply Pararefl
    have lem5 : IsParallel l1 l2 := by
      apply ParaTrans l1 lab l2 lem3 lem4
    contradiction

-- if a ray stands on a line, then the adjacent angles sum to 180
axiom RSL (a b c o: Point )(l : Line) (R : Segment)(h1 : lies_on a (line_from_seg R))(h2 : lies_on b l) (h3 : lies_on c l)
(h4 : lies_on o l) (h5 : lies_on o (line_from_seg R)):
let AOB := Angle.mk a o b
let AOC := Angle.mk a o c
mAngle (AOB) + mAngle (AOC) = 180

/-
-- corresponding angles are equal
axiom  COAequal (l1 l2 l3 : Line) (h :  ¬ IsParallel l1 l3) (h' : IsParallel l1 l2 )
(a b p1 p2 p3 p4 : Point) (lies_on a l1)  (lies_on a l3) (lies_on b l2) (lies_on b l3)
(lies_on p1 l1) (lies_on p2 l1) (lies_on p3 l2) (lies_on p4 l2) :
let P1AB := Angle.mk p1 a b
let P2AB := Angle.mk p2 a b
mAngle (P1AB) = mAngle (P2AB)

-- if sum of adjacent angles is 180, then a line is formed by them
axiom SOA (a b c o : Point)
let AOC := Angle.mk a o c
let BOC := Angle.mk b o c
(h : mAngle (AOC) + mAngle (BOC) = 180 )
(lies_on a (S1 : Segment)) (lies_on b (S2 : Segment))
(lies_on o (S1 : Segment)) (lies_on o (S2 : Segment))
(lies_on o  (S3 : Segment )) (lies_on c (S3: Segment))
(l1 : line_from_seg S1) ( l2 : line_from_seg S2) :
l1 = l2 ∧ lies_on a l1 ∧ lies_on b l1 ∧ lies_on o l1
-/

theorem VOAequal (l1 l2 : Line) (h : ¬ IsParallel l1 l2)
(a b c d e : Point ) :
lies_on a l1 ∧ lies_on b l1
→
lies_on c l2 ∧ lies_on d l2
→
lies_on e l1 ∧ lies_on e l2
→
let AED := Angle.mk a e d
let CEB := Angle.mk c e b
let AEC := Angle.mk a e c
let BED := Angle.mk b e d
mAngle (AEC) = mAngle (BED) ∧  mAngle (AED) = mAngle (CEB)
:= by
intro h1 h2 h3 h4 h5
let R := Segment.mk c e
let R' := Segment.mk a e
let R'' := Segment.mk d e

have lem1 : lies_on c (line_from_seg R) :=
  And.left (contain_end_points R)

have lem2 : lies_on b l1 :=
  And.right h1

have lem3 : lies_on a l1 :=
  And.left h1

have lem4 : lies_on e l1 :=
  And.left h3

have lem5 : lies_on e (line_from_seg R) :=
  And.right (contain_end_points R )

apply RSL c a b e l1 R lem1 lem2 lem3 lem4 lem5-- mAngle (AEC)+ mAngle (BEC) = 180
apply RSL a d c e l2 R' --  mAngle (AEC) + mAngle (AED) = 180
-- subtract above two → mAngle (BEC) = mAngle (AED)
apply RSL a d c e l2 R' -- mAngle (AEC) + mAngle(AED) = 180
apply RSL a b d e l2 R'' -- mAngle (AED) + mAngle (BED) = 180
-- subtract above two → mAngle (AEC) = mAngle (BED)


theorem ex1 (n m : Nat) : some n = some m → n = m := by
  intro h
  injection h with h
  exact h


import data.finite.finord
import system.io

open finord

#eval io.put_str_ln "======================"
#eval io.put_str_ln "  data.finite.finord  "
#eval io.put_str_ln "======================"

#eval io.put_str_ln "Axioms:"
#print axioms zero_empty
#print axioms fz_not_fs
#print axioms fs_inj
#print axioms finord.lt
#print axioms finord.lt_decidable
#print axioms finord.lt_irrefl
#print axioms finord.lt_asymm
#print axioms finord.lt_incomp_eq
#print axioms finord.lt_trans
#print axioms finord.lt_trichotomous
#print axioms inject_succ
#print axioms inject
#print axioms to_fin
#print axioms to_fs_succ
#print axioms from_fin
#print axioms from_succ_fs
#print axioms fromto_id
#print axioms tofrom_id
#print axioms card_of

definition is_mul_of_three : Π {n : ℕ}, finord n → Prop
| _ fz := true
| _ (fs fz) := false
| _ (fs (fs fz)) := false
| _ (fs (fs (fs n))) := is_mul_of_three n

instance test_dec : ∀ n (k : finord n), decidable (is_mul_of_three k)
| _ fz := is_true true.intro
| _ (fs fz) := is_false false.elim
| _ (fs (fs fz)) := is_false false.elim
| _ (fs (fs (fs k))) := test_dec _ k

example : card_of (@is_mul_of_three 0) = 0 := rfl
example : card_of (@is_mul_of_three 1) = 1 := rfl
example : card_of (@is_mul_of_three 2) = 1 := rfl
example : card_of (@is_mul_of_three 3) = 1 := rfl
example : card_of (@is_mul_of_three 4) = 2 := rfl
example : card_of (@is_mul_of_three 5) = 2 := rfl
example : card_of (@is_mul_of_three 6) = 2 := rfl
example : card_of (@is_mul_of_three 7) = 3 := rfl
example : card_of (@is_mul_of_three 8) = 3 := rfl
example : card_of (@is_mul_of_three 9) = 3 := rfl
example : card_of (@is_mul_of_three 10) = 4 := rfl
example : card_of (@is_mul_of_three 11) = 4 := rfl
example : card_of (@is_mul_of_three 12) = 4 := rfl
example : card_of (@is_mul_of_three 13) = 5 := rfl


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta, Adam Topaz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.functor_category
import Mathlib.PostPort

universes v₁ u₁ l

namespace Mathlib

namespace category_theory

/--
The data of a monad on C consists of an endofunctor T together with natural transformations
η : 𝟭 C ⟶ T and μ : T ⋙ T ⟶ T satisfying three equations:
- T μ_X ≫ μ_X = μ_(TX) ≫ μ_X (associativity)
- η_(TX) ≫ μ_X = 1_X (left unit)
- Tη_X ≫ μ_X = 1_X (right unit)
-/
class monad {C : Type u₁} [category C] (T : C ⥤ C) where
  η : 𝟭 ⟶ T
  μ : T ⋙ T ⟶ T
  assoc' :
    autoParam
      (∀ (X : C),
        functor.map T (nat_trans.app μ X) ≫ nat_trans.app μ X =
          nat_trans.app μ (functor.obj T X) ≫ nat_trans.app μ X)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  left_unit' :
    autoParam (∀ (X : C), nat_trans.app η (functor.obj T X) ≫ nat_trans.app μ X = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  right_unit' :
    autoParam (∀ (X : C), functor.map T (nat_trans.app η X) ≫ nat_trans.app μ X = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

theorem monad.assoc {C : Type u₁} [category C] {T : C ⥤ C} [c : monad T] (X : C) :
    functor.map T (nat_trans.app (monad.μ T) X) ≫ nat_trans.app (monad.μ T) X =
        nat_trans.app (monad.μ T) (functor.obj T X) ≫ nat_trans.app (monad.μ T) X :=
  sorry

@[simp] theorem monad.left_unit {C : Type u₁} [category C] {T : C ⥤ C} [c : monad T] (X : C) :
    nat_trans.app (monad.η T) (functor.obj T X) ≫ nat_trans.app (monad.μ T) X = 𝟙 :=
  sorry

@[simp] theorem monad.right_unit {C : Type u₁} [category C] {T : C ⥤ C} [c : monad T] (X : C) :
    functor.map T (nat_trans.app (monad.η T) X) ≫ nat_trans.app (monad.μ T) X = 𝟙 :=
  sorry

@[simp] theorem monad.right_unit_assoc {C : Type u₁} [category C] {T : C ⥤ C} [c : monad T] (X : C)
    {X' : C} (f' : functor.obj T X ⟶ X') :
    functor.map T (nat_trans.app (monad.η T) X) ≫ nat_trans.app (monad.μ T) X ≫ f' = f' :=
  sorry

notation:1024 "η_" => Mathlib.category_theory.monad.η

notation:1024 "μ_" => Mathlib.category_theory.monad.μ

/--
The data of a comonad on C consists of an endofunctor G together with natural transformations
ε : G ⟶ 𝟭 C and δ : G ⟶ G ⋙ G satisfying three equations:
- δ_X ≫ G δ_X = δ_X ≫ δ_(GX) (coassociativity)
- δ_X ≫ ε_(GX) = 1_X (left counit)
- δ_X ≫ G ε_X = 1_X (right counit)
-/
class comonad {C : Type u₁} [category C] (G : C ⥤ C) where
  ε : G ⟶ 𝟭
  δ : G ⟶ G ⋙ G
  coassoc' :
    autoParam
      (∀ (X : C),
        nat_trans.app δ X ≫ functor.map G (nat_trans.app δ X) =
          nat_trans.app δ X ≫ nat_trans.app δ (functor.obj G X))
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  left_counit' :
    autoParam (∀ (X : C), nat_trans.app δ X ≫ nat_trans.app ε (functor.obj G X) = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  right_counit' :
    autoParam (∀ (X : C), nat_trans.app δ X ≫ functor.map G (nat_trans.app ε X) = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

theorem comonad.coassoc {C : Type u₁} [category C] {G : C ⥤ C} [c : comonad G] (X : C) :
    nat_trans.app (comonad.δ G) X ≫ functor.map G (nat_trans.app (comonad.δ G) X) =
        nat_trans.app (comonad.δ G) X ≫ nat_trans.app (comonad.δ G) (functor.obj G X) :=
  sorry

@[simp] theorem comonad.left_counit {C : Type u₁} [category C] {G : C ⥤ C} [c : comonad G] (X : C) :
    nat_trans.app (comonad.δ G) X ≫ nat_trans.app (comonad.ε G) (functor.obj G X) = 𝟙 :=
  sorry

@[simp] theorem comonad.right_counit {C : Type u₁} [category C] {G : C ⥤ C} [c : comonad G]
    (X : C) : nat_trans.app (comonad.δ G) X ≫ functor.map G (nat_trans.app (comonad.ε G) X) = 𝟙 :=
  sorry

@[simp] theorem comonad.left_counit_assoc {C : Type u₁} [category C] {G : C ⥤ C} [c : comonad G]
    (X : C) {X' : C} (f' : functor.obj G X ⟶ X') :
    nat_trans.app (comonad.δ G) X ≫ nat_trans.app (comonad.ε G) (functor.obj G X) ≫ f' = f' :=
  sorry

notation:1024 "ε_" => Mathlib.category_theory.comonad.ε

notation:1024 "δ_" => Mathlib.category_theory.comonad.δ

/-- A morphisms of monads is a natural transformation compatible with η and μ. -/
structure monad_hom {C : Type u₁} [category C] (M : C ⥤ C) (N : C ⥤ C) [monad M] [monad N]
    extends nat_trans M N where
  app_η' :
    autoParam (∀ {X : C}, nat_trans.app η_ X ≫ nat_trans.app _to_nat_trans X = nat_trans.app η_ X)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  app_μ' :
    autoParam
      (∀ {X : C},
        nat_trans.app μ_ X ≫ nat_trans.app _to_nat_trans X =
          (functor.map M (nat_trans.app _to_nat_trans X) ≫
              nat_trans.app _to_nat_trans (functor.obj N X)) ≫
            nat_trans.app μ_ X)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem monad_hom.app_η {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M]
    [monad N] (c : monad_hom M N) {X : C} :
    nat_trans.app η_ X ≫ nat_trans.app (monad_hom.to_nat_trans c) X = nat_trans.app η_ X :=
  sorry

@[simp] theorem monad_hom.app_μ {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M]
    [monad N] (c : monad_hom M N) {X : C} :
    nat_trans.app μ_ X ≫ nat_trans.app (monad_hom.to_nat_trans c) X =
        (functor.map M (nat_trans.app (monad_hom.to_nat_trans c) X) ≫
            nat_trans.app (monad_hom.to_nat_trans c) (functor.obj N X)) ≫
          nat_trans.app μ_ X :=
  sorry

@[simp] theorem monad_hom.app_η_assoc {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M]
    [monad N] (c : monad_hom M N) {X : C} {X' : C} (f' : functor.obj N X ⟶ X') :
    nat_trans.app η_ X ≫ nat_trans.app (monad_hom.to_nat_trans c) X ≫ f' =
        nat_trans.app η_ X ≫ f' :=
  sorry

/-- A morphisms of comonads is a natural transformation compatible with η and μ. -/
structure comonad_hom {C : Type u₁} [category C] (M : C ⥤ C) (N : C ⥤ C) [comonad M] [comonad N]
    extends nat_trans M N where
  app_ε' :
    autoParam (∀ {X : C}, nat_trans.app _to_nat_trans X ≫ nat_trans.app ε_ X = nat_trans.app ε_ X)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  app_δ' :
    autoParam
      (∀ {X : C},
        nat_trans.app _to_nat_trans X ≫ nat_trans.app δ_ X =
          nat_trans.app δ_ X ≫
            nat_trans.app _to_nat_trans (functor.obj M X) ≫
              functor.map N (nat_trans.app _to_nat_trans X))
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem comonad_hom.app_ε {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M]
    [comonad N] (c : comonad_hom M N) {X : C} :
    nat_trans.app (comonad_hom.to_nat_trans c) X ≫ nat_trans.app ε_ X = nat_trans.app ε_ X :=
  sorry

@[simp] theorem comonad_hom.app_δ {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M]
    [comonad N] (c : comonad_hom M N) {X : C} :
    nat_trans.app (comonad_hom.to_nat_trans c) X ≫ nat_trans.app δ_ X =
        nat_trans.app δ_ X ≫
          nat_trans.app (comonad_hom.to_nat_trans c) (functor.obj M X) ≫
            functor.map N (nat_trans.app (comonad_hom.to_nat_trans c) X) :=
  sorry

@[simp] theorem comonad_hom.app_δ_assoc {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C}
    [comonad M] [comonad N] (c : comonad_hom M N) {X : C} {X' : C}
    (f' : functor.obj N (functor.obj N X) ⟶ X') :
    nat_trans.app (comonad_hom.to_nat_trans c) X ≫ nat_trans.app δ_ X ≫ f' =
        nat_trans.app δ_ X ≫
          nat_trans.app (comonad_hom.to_nat_trans c) (functor.obj M X) ≫
            functor.map N (nat_trans.app (comonad_hom.to_nat_trans c) X) ≫ f' :=
  sorry

namespace monad_hom

theorem ext {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M] [monad N]
    (f : monad_hom M N) (g : monad_hom M N) : to_nat_trans f = to_nat_trans g → f = g :=
  sorry

/-- The identity natural transformations is a morphism of monads. -/
def id {C : Type u₁} [category C] (M : C ⥤ C) [monad M] : monad_hom M M :=
  mk (nat_trans.mk (nat_trans.app 𝟙))

protected instance inhabited {C : Type u₁} [category C] {M : C ⥤ C} [monad M] :
    Inhabited (monad_hom M M) :=
  { default := id M }

/-- The composition of two morphisms of monads. -/
def comp {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} {L : C ⥤ C} [monad M] [monad N]
    [monad L] (f : monad_hom M N) (g : monad_hom N L) : monad_hom M L :=
  mk
    (nat_trans.mk
      fun (X : C) => nat_trans.app (to_nat_trans f) X ≫ nat_trans.app (to_nat_trans g) X)

@[simp] theorem id_comp {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M] [monad N]
    (f : monad_hom M N) : comp (id M) f = f :=
  ext (comp (id M) f) f
    (nat_trans.ext (to_nat_trans (comp (id M) f)) (to_nat_trans f)
      (funext fun (x : C) => category.id_comp (nat_trans.app (to_nat_trans f) x)))

@[simp] theorem comp_id {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [monad M] [monad N]
    (f : monad_hom M N) : comp f (id N) = f :=
  ext (comp f (id N)) f
    (nat_trans.ext (to_nat_trans (comp f (id N))) (to_nat_trans f)
      (funext fun (x : C) => category.comp_id (nat_trans.app (to_nat_trans f) x)))

/-- Note: `category_theory.monad.bundled` provides a category instance for bundled monads.-/
@[simp] theorem assoc {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} {L : C ⥤ C} {K : C ⥤ C}
    [monad M] [monad N] [monad L] [monad K] (f : monad_hom M N) (g : monad_hom N L)
    (h : monad_hom L K) : comp (comp f g) h = comp f (comp g h) :=
  sorry

end monad_hom

namespace comonad_hom

theorem ext {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M] [comonad N]
    (f : comonad_hom M N) (g : comonad_hom M N) : to_nat_trans f = to_nat_trans g → f = g :=
  sorry

/-- The identity natural transformations is a morphism of comonads. -/
def id {C : Type u₁} [category C] (M : C ⥤ C) [comonad M] : comonad_hom M M :=
  mk (nat_trans.mk (nat_trans.app 𝟙))

protected instance inhabited {C : Type u₁} [category C] {M : C ⥤ C} [comonad M] :
    Inhabited (comonad_hom M M) :=
  { default := id M }

/-- The composition of two morphisms of comonads. -/
def comp {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} {L : C ⥤ C} [comonad M] [comonad N]
    [comonad L] (f : comonad_hom M N) (g : comonad_hom N L) : comonad_hom M L :=
  mk
    (nat_trans.mk
      fun (X : C) => nat_trans.app (to_nat_trans f) X ≫ nat_trans.app (to_nat_trans g) X)

@[simp] theorem id_comp {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M] [comonad N]
    (f : comonad_hom M N) : comp (id M) f = f :=
  ext (comp (id M) f) f
    (nat_trans.ext (to_nat_trans (comp (id M) f)) (to_nat_trans f)
      (funext fun (x : C) => category.id_comp (nat_trans.app (to_nat_trans f) x)))

@[simp] theorem comp_id {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} [comonad M] [comonad N]
    (f : comonad_hom M N) : comp f (id N) = f :=
  ext (comp f (id N)) f
    (nat_trans.ext (to_nat_trans (comp f (id N))) (to_nat_trans f)
      (funext fun (x : C) => category.comp_id (nat_trans.app (to_nat_trans f) x)))

/-- Note: `category_theory.monad.bundled` provides a category instance for bundled comonads.-/
@[simp] theorem assoc {C : Type u₁} [category C] {M : C ⥤ C} {N : C ⥤ C} {L : C ⥤ C} {K : C ⥤ C}
    [comonad M] [comonad N] [comonad L] [comonad K] (f : comonad_hom M N) (g : comonad_hom N L)
    (h : comonad_hom L K) : comp (comp f g) h = comp f (comp g h) :=
  sorry

end comonad_hom

namespace monad

protected instance category_theory.functor.id.monad {C : Type u₁} [category C] : monad 𝟭 := mk 𝟙 𝟙

end monad

namespace comonad

protected instance category_theory.functor.id.comonad {C : Type u₁} [category C] : comonad 𝟭 :=
  mk 𝟙 𝟙

end Mathlib


/- Multi-way branches (``switch'' statements) and their compilation
    to comparison trees. -/

import .values

namespace switch
open values word integers maps

inductive switch_argument : bool → val → Π w:ℕ+, word w → Prop
| switch_argument_32 (i) : switch_argument ff (Vint i) _ i
| switch_argument_64 (i) : switch_argument tt (Vlong i) _ i

section
parameter wordsize : ℕ+

local notation `uword` := uword wordsize

/- A multi-way branch is composed of a list of (key, action) pairs,
  plus a default action.  -/

def table : Type := list (uword × ℕ)

def switch_target (n : uword) (dfl : ℕ) : table → ℕ
| []                     := dfl
| ((key, action) :: rem) := if n = key then action else switch_target rem

def switch_target' (n : uword) (dfl : ℕ) (tbl : list (ℤ × ℕ)) : ℕ :=
switch_target n dfl $ tbl.map (λ⟨a, b⟩, (repr a, b))

/- Multi-way branches are translated to comparison trees.
    Each node of the tree performs either
- an equality against one of the keys;
- or a "less than" test against one of the keys;
- or a computed branch (jump table) against a range of key values. -/

inductive comptree : Type
| CTaction {} (act : ℕ)
| CTifeq (key : uword) (act : ℕ) (cne : comptree)
| CTiflt (key : uword) (clt : comptree) (cge : comptree)
| CTjumptable (ofs sz : uword) (acts : list ℕ) (h : (sz:ℕ) ≤ acts.length) (cother : comptree)
open comptree

def comptree_match (n : uword) : comptree → option ℕ
| (CTaction act) := some act
| (CTifeq key act t') := if n = key then some act else comptree_match t'
| (CTiflt key t1 t2) := if n < key then comptree_match t1 else comptree_match t2
| (CTjumptable ofs sz tbl sl t') :=
  let delta := n - ofs in
  if h : delta < sz
  then some (list.nth_le tbl (unsigned delta) (lt_of_lt_of_le h sl))
  else comptree_match t'

def comptree_match' (n : uword) (dfl : ℕ) (t : comptree) : ℕ :=
(comptree_match n t).get_or_else dfl

/- The translation from a table to a comparison tree is performed
  by untrusted Caml code (function [compile_switch] in
  file [RTLgenaux.ml]).  In Coq, we validate a posteriori the
  result of this function.  In other terms, we now develop
  and prove correct Coq functions that take a table and a comparison
  tree, and check that their semantics are equivalent. -/

def split_lt (pivot : uword) (cases : table) : table × table :=
cases.partition (λ e, e.1 < pivot)

def split_eq (pivot : uword) : table → option ℕ × table
| [] := (none, [])
| ((key, act) :: rem) :=
  let (same, others) := split_eq rem in
  if key = pivot
  then (some act, others)
  else (same, (key, act) :: others)

def split_between (ofs sz : uword) : table → PTree ℕ × table
| [] := (∅, [])
| ((key, act) :: rem) :=
  let (inside, outside) := split_between rem in
  if key - ofs < sz
  then (PTree.set (pos_num.of_nat_succ key) act inside, outside)
  else (inside, (key, act) :: outside)

def refine_low_bound (v lo : uword) := if v = lo then lo + 1 else lo

def refine_high_bound (v hi : uword) := if v = hi then hi - 1 else hi

def validate_jumptable (dfl : ℕ) (cases : PTree ℕ) : Π (tbl : list ℕ) (n : uword),
  semidecidable (∀ (v : uword) h,
    tbl.nth_le (unsigned (v - n)) h = cases.get_or (pos_num.of_nat_succ v) dfl)
| []           n := semidecidable.success $ λ v h, absurd h (nat.not_lt_zero _)
| (act :: rem) n :=
  semidecidable.bind (act = cases.get_or (pos_num.of_nat_succ n) dfl) $ λae,
  @semidecidable.bind _ _ (validate_jumptable rem (n + 1)) $ λIH,
  semidecidable.success $
  show ∀ (v : uword) h, list.nth_le (act :: rem) (unsigned (v - n)) h =
      PTree.get_or (pos_num.of_nat_succ ↑v) cases dfl, begin
    intro v,
    ginduction unsigned (v - n) with u; rw u; dsimp [list.nth_le]; intro h,
    { note vn : v = n := eq_of_sub_eq_zero (unsigned_eq.2 $ eq.trans u unsigned_zero.symm),
      rw vn, exact ae },
    { assert va : unsigned (v - (n + 1)) = a,
      { rw [-sub_sub, sub_unsigned, unsigned_one, u, -int.coe_nat_sub, unsigned_repr],
        refl,
        { change a ≤ _,
          apply nat.le_of_succ_le,
          rw -u, apply unsigned_range_2 },
        { apply nat.succ_pos } },
      note : ∀ h, list.nth_le rem (unsigned (v - (n + 1))) h =
                  PTree.get_or (pos_num.of_nat_succ ↑v) cases dfl := IH v,
      rw va at this, apply this }
  end

def table_tree_agree' (dfl : ℕ) (cases : table) (t : comptree) (lo hi : uword) : Prop :=
∀ ⦃n⦄, lo ≤ n → n ≤ hi → switch_target n dfl cases = comptree_match' n dfl t

def table_tree_agree (dfl : ℕ) (cases : table) (t : comptree) : Prop :=
∀ ⦃n⦄, switch_target n dfl cases = comptree_match' n dfl t

lemma split_eq_prop (dfl : ℕ) {pivot cases} (v) : ∀ ⦃optact cases'⦄,
  split_eq pivot cases = (optact, cases') →
  switch_target v dfl cases =
   (if v = pivot then optact.get_or_else dfl
    else switch_target v dfl cases') := sorry'

lemma split_lt_prop (dfl : ℕ) {pivot cases} (v) : ∀ ⦃lcases rcases⦄,
  split_lt pivot cases = (lcases, rcases) →
  switch_target v dfl cases =
    (if v < pivot
     then switch_target v dfl lcases
     else switch_target v dfl rcases) := sorry'

lemma split_between_prop (dfl : ℕ) (v) {ofs sz} : ∀ {cases} ⦃inside outside⦄,
  split_between ofs sz cases = (inside, outside) →
  switch_target v dfl cases =
    (if v - ofs < sz
     then PTree.get_or (pos_num.of_nat_succ v) inside dfl
     else switch_target v dfl outside) := sorry'

def validate (dfl : ℕ) : Π (cases : table) (t : comptree) (lo hi : uword),
  semidecidable (table_tree_agree' dfl cases t lo hi)
| []                  (CTaction act) lo hi :=
  semidecidable.bind (dfl = act) $ λh,
  semidecidable.success $ λ n nl nh, h
| ((key1, act1) :: _) (CTaction act) lo hi :=
  semidecidable.bind (key1 = lo ∧ lo = hi ∧ act1 = act) $ λ⟨kl, lh, aa⟩,
  semidecidable.success $ λ n nl nh,
  begin
    dsimp [switch_target], rw if_pos, exact aa,
    rw [kl], rw -lh at nh, exact le_antisymm nh nl
  end
| cases (CTifeq pivot act t') lo hi :=
  match _, rfl : ∀ x, split_eq pivot cases = x → _ with
  | (none, _), _ := semidecidable.fail
  | (some act', others), se :=
    semidecidable.bind (act' = act) $ λaa,
    @semidecidable.bind _ _ (validate others t'
      (refine_low_bound pivot lo) (refine_high_bound pivot hi)) $ λIH,
    semidecidable.success $
    show table_tree_agree' dfl cases (CTifeq pivot act t') lo hi, begin
      rw aa at se, intros n nl nh,
      rw [split_eq_prop _ dfl n se],
      by_cases n = pivot with np; simp [np, option.get_or_else, comptree_match', comptree_match],
      apply IH,
      { dsimp [refine_low_bound], by_cases pivot = lo with pl; simp [pl],
        { rw pl at np, exact uword.succ_le_of_lt (lt_of_le_of_ne nl (ne.symm np)) },
        { exact nl } },
      { dsimp [refine_high_bound], by_cases pivot = hi with ph; simp [ph],
        { rw ph at np, exact uword.le_pred_of_lt (lt_of_le_of_ne nh np) },
        { exact nh } }
    end
  end
| cases (CTiflt pivot t1 t2) lo hi :=
  match _, rfl : ∀ x, split_lt pivot cases = x → _ with
  | (lcases, rcases), sl :=
    @semidecidable.bind _ _ (validate lcases t1 lo (pivot - 1)) $ λL,
    @semidecidable.bind _ _ (validate rcases t2 pivot hi) $ λR,
    semidecidable.success $
    show table_tree_agree' dfl cases (CTiflt pivot t1 t2) lo hi, begin
      intros n nl nh,
      rw [split_lt_prop _ dfl n sl],
      by_cases (n < pivot) with lp; simp [lp, comptree_match', comptree_match],
      exact L nl (uword.le_pred_of_lt lp),
      exact R (le_of_not_gt lp) nh,
    end
  end
| cases (CTjumptable ofs sz tbl h t') lo hi :=
  match _, rfl : ∀ x, split_between ofs sz cases = x → _ with
  | (inside, outside), sb :=
    @semidecidable.bind _ _ (validate_jumptable dfl inside tbl ofs) $ λI,
    @semidecidable.bind _ _ (validate outside t' lo hi) $ λO,
    semidecidable.success $
    show table_tree_agree' dfl cases (CTjumptable ofs sz tbl h t') lo hi, begin
      intros n nl nh,
      rw [split_between_prop _ dfl n sb],
      dsimp only [comptree_match', comptree_match],
      cases (by apply_instance : decidable (n - ofs < sz)) with ns ns; dsimp only [ite, dite, option.get_or_else],
      exact O nl nh,
      { rw I }
    end
  end

def validate_switch (dfl : ℕ) (cases : table) (t : comptree) :
  semidecidable (table_tree_agree dfl cases t) :=
begin
  refine @semidecidable.of_imp _ _ _ (validate _ dfl cases t 0 (repr (max_unsigned wordsize))),
  intros h n,
  apply h (uword.zero_le _),
  unfold has_le.le leu,
  rw unsigned_repr,
  { apply unsigned_range_2 },
  { apply le_refl }
end

/- Caml code for compile_switch

module ZSet = Set.Make(Z)

let normalize_table tbl =
  let rec norm keys accu = function
  | [] -> (accu, keys)
  | (key, act) :: rem ->
      if ZSet.mem key keys
      then norm keys accu rem
      else norm (ZSet.add key keys) ((key, act) :: accu) rem
  in norm ZSet.empty [] tbl

let compile_switch_as_tree modulus default tbl =
  let sw = Array.of_list tbl in
  Array.stable_sort (fun (n1, _) (n2, _) -> Z.compare n1 n2) sw;
  let rec build lo hi minval maxval =
    match hi - lo with
    | 0 ->
       CTaction default
    | 1 ->
       let (key, act) = sw.(lo) in
       if Z.sub maxval minval = Z.zero
       then CTaction act
       else CTifeq(key, act, CTaction default)
    | 2 ->
       let (key1, act1) = sw.(lo)
       and (key2, act2) = sw.(lo+1) in
       CTifeq(key1, act1,
         if Z.sub maxval minval = Z.one
         then CTaction act2
         else CTifeq(key2, act2, CTaction default))
    | 3 ->
       let (key1, act1) = sw.(lo)
       and (key2, act2) = sw.(lo+1)
       and (key3, act3) = sw.(lo+2) in
       CTifeq(key1, act1,
        CTifeq(key2, act2,
          if Z.sub maxval minval = Z.of_uint 2
          then CTaction act3
          else CTifeq(key3, act3, CTaction default)))
    | _ ->
       let mid = (lo + hi) / 2 in
       let (pivot, _) = sw.(mid) in
       CTiflt(pivot,
              build lo mid minval (Z.sub pivot Z.one),
              build mid hi pivot maxval)
  in build 0 (Array.length sw) Z.zero modulus

let compile_switch_as_jumptable default cases minkey maxkey =
  let tblsize = 1 + Z.to_int (Z.sub maxkey minkey) in
  assert (tblsize >= 0 && tblsize <= Sys.max_array_length);
  let tbl = Array.make tblsize default in
  List.iter
    (fun (key, act) ->
       let pos = Z.to_int (Z.sub key minkey) in
       tbl.(pos) <- act)
    cases;
  CTjumptable(minkey,
              Z.of_uint tblsize,
              Array.to_list tbl,
              CTaction default)

let dense_enough (numcases: int) (minkey: Z.t) (maxkey: Z.t) =
  let span = Z.sub maxkey minkey in
  assert (Z.ge span Z.zero);
  let tree_size = Z.mul (Z.of_uint 4) (Z.of_uint numcases)
  and table_size = Z.add (Z.of_uint 8) span in
  numcases >= 7           (* small jump tables are always less efficient *)
  && Z.le table_size tree_size
  && Z.lt span (Z.of_uint Sys.max_array_length)

let compile_switch modulus default table =
  let (tbl, keys) = normalize_table table in
  if ZSet.is_empty keys then CTaction default else begin
    let minkey = ZSet.min_elt keys
    and maxkey = ZSet.max_elt keys in
    if dense_enough (List.length tbl) minkey maxkey
    then compile_switch_as_jumptable default tbl minkey maxkey
    else compile_switch_as_tree modulus default tbl
  end
-/

end
end switch


import data.real.basic

/- Tactics you may consider
-intros
-rw
-apply
-exact
-use
-/

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

variable (a : ℝ)

-- BEGIN
theorem converges_to_const : converges_to (λ x : ℕ, a) a :=
begin
  intros ε εpos,
  use 0,
  intros n nge, dsimp,
  sorry,
end
-- END