/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.list
import Mathlib.logic.function.iterate
import Mathlib.PostPort

universes u_1 l u_2 u_3 u_5 u_4

namespace Mathlib

/-!
# The primitive recursive functions

The primitive recursive functions are the least collection of functions
`nat → nat` which are closed under projections (using the mkpair
pairing function), composition, zero, successor, and primitive recursion
(i.e. nat.rec where the motive is C n := nat).

We can extend this definition to a large class of basic types by
using canonical encodings of types as natural numbers (Gödel numbering),
which we implement through the type class `encodable`. (More precisely,
we need that the composition of encode with decode yields a
primitive recursive function, so we have the `primcodable` type class
for this.)

## References

* [Mario Carneiro, *Formalizing computability theory via partial recursive functions*][carneiro2019]
-/

namespace nat

def elim {C : Sort u_1} : C → (ℕ → C → C) → ℕ → C := Nat.rec

@[simp] theorem elim_zero {C : Sort u_1} (a : C) (f : ℕ → C → C) : elim a f 0 = a := rfl

@[simp] theorem elim_succ {C : Sort u_1} (a : C) (f : ℕ → C → C) (n : ℕ) :
    elim a f (Nat.succ n) = f n (elim a f n) :=
  rfl

def cases {C : Sort u_1} (a : C) (f : ℕ → C) : ℕ → C := elim a fun (n : ℕ) (_x : C) => f n

@[simp] theorem cases_zero {C : Sort u_1} (a : C) (f : ℕ → C) : cases a f 0 = a := rfl

@[simp] theorem cases_succ {C : Sort u_1} (a : C) (f : ℕ → C) (n : ℕ) :
    cases a f (Nat.succ n) = f n :=
  rfl

@[simp] def unpaired {α : Sort u_1} (f : ℕ → ℕ → α) (n : ℕ) : α :=
  f (prod.fst (unpair n)) (prod.snd (unpair n))

/-- The primitive recursive functions `ℕ → ℕ`. -/
inductive primrec : (ℕ → ℕ) → Prop where
| zero : primrec fun (n : ℕ) => 0
| succ : primrec Nat.succ
| left : primrec fun (n : ℕ) => prod.fst (unpair n)
| right : primrec fun (n : ℕ) => prod.snd (unpair n)
| pair : ∀ {f g : ℕ → ℕ}, primrec f → primrec g → primrec fun (n : ℕ) => mkpair (f n) (g n)
| comp : ∀ {f g : ℕ → ℕ}, primrec f → primrec g → primrec fun (n : ℕ) => f (g n)
| prec :
    ∀ {f g : ℕ → ℕ},
      primrec f →
        primrec g →
          primrec
            (unpaired fun (z n : ℕ) => elim (f z) (fun (y IH : ℕ) => g (mkpair z (mkpair y IH))) n)

namespace primrec

theorem of_eq {f : ℕ → ℕ} {g : ℕ → ℕ} (hf : primrec f) (H : ∀ (n : ℕ), f n = g n) : primrec g :=
  funext H ▸ hf

theorem const (n : ℕ) : primrec fun (_x : ℕ) => n := sorry

protected theorem id : primrec id := sorry

theorem prec1 {f : ℕ → ℕ} (m : ℕ) (hf : primrec f) :
    primrec fun (n : ℕ) => elim m (fun (y IH : ℕ) => f (mkpair y IH)) n :=
  sorry

theorem cases1 {f : ℕ → ℕ} (m : ℕ) (hf : primrec f) : primrec (cases m f) := sorry

theorem cases {f : ℕ → ℕ} {g : ℕ → ℕ} (hf : primrec f) (hg : primrec g) :
    primrec (unpaired fun (z n : ℕ) => cases (f z) (fun (y : ℕ) => g (mkpair z y)) n) :=
  sorry

protected theorem swap : primrec (unpaired (function.swap mkpair)) := sorry

theorem swap' {f : ℕ → ℕ → ℕ} (hf : primrec (unpaired f)) : primrec (unpaired (function.swap f)) :=
  sorry

theorem pred : primrec Nat.pred := sorry

theorem add : primrec (unpaired Add.add) := sorry

theorem sub : primrec (unpaired Sub.sub) := sorry

theorem mul : primrec (unpaired Mul.mul) := sorry

theorem pow : primrec (unpaired pow) := sorry

end primrec

end nat

/-- A `primcodable` type is an `encodable` type for which
  the encode/decode functions are primitive recursive. -/
class primcodable (α : Type u_1) extends encodable α where
  prim : nat.primrec fun (n : ℕ) => encodable.encode (encodable.decode α n)

namespace primcodable

protected instance of_denumerable (α : Type u_1) [denumerable α] : primcodable α := mk sorry

def of_equiv (α : Type u_1) {β : Type u_2} [primcodable α] (e : β ≃ α) : primcodable β := mk sorry

protected instance empty : primcodable empty := mk nat.primrec.zero

protected instance unit : primcodable PUnit := mk sorry

protected instance option {α : Type u_1} [h : primcodable α] : primcodable (Option α) := mk sorry

protected instance bool : primcodable Bool := mk sorry

end primcodable

/-- `primrec f` means `f` is primitive recursive (after
  encoding its input and output as natural numbers). -/
def primrec {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (f : α → β) :=
  nat.primrec fun (n : ℕ) => encodable.encode (option.map f (encodable.decode α n))

namespace primrec

protected theorem encode {α : Type u_1} [primcodable α] : primrec encodable.encode := sorry

protected theorem decode {α : Type u_1} [primcodable α] : primrec (encodable.decode α) :=
  nat.primrec.comp nat.primrec.succ (primcodable.prim α)

theorem dom_denumerable {α : Type u_1} {β : Type u_2} [denumerable α] [primcodable β] {f : α → β} :
    primrec f ↔ nat.primrec fun (n : ℕ) => encodable.encode (f (denumerable.of_nat α n)) :=
  sorry

theorem nat_iff {f : ℕ → ℕ} : primrec f ↔ nat.primrec f := dom_denumerable

theorem encdec {α : Type u_1} [primcodable α] :
    primrec fun (n : ℕ) => encodable.encode (encodable.decode α n) :=
  iff.mpr nat_iff (primcodable.prim α)

theorem option_some {α : Type u_1} [primcodable α] : primrec some := sorry

theorem of_eq {α : Type u_1} {σ : Type u_3} [primcodable α] [primcodable σ] {f : α → σ} {g : α → σ}
    (hf : primrec f) (H : ∀ (n : α), f n = g n) : primrec g :=
  funext H ▸ hf

theorem const {α : Type u_1} {σ : Type u_3} [primcodable α] [primcodable σ] (x : σ) :
    primrec fun (a : α) => x :=
  sorry

protected theorem id {α : Type u_1} [primcodable α] : primrec id := sorry

theorem comp {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] {f : β → σ} {g : α → β} (hf : primrec f) (hg : primrec g) :
    primrec fun (a : α) => f (g a) :=
  sorry

theorem succ : primrec Nat.succ := iff.mpr nat_iff nat.primrec.succ

theorem pred : primrec Nat.pred := iff.mpr nat_iff nat.primrec.pred

theorem encode_iff {α : Type u_1} {σ : Type u_3} [primcodable α] [primcodable σ] {f : α → σ} :
    (primrec fun (a : α) => encodable.encode (f a)) ↔ primrec f :=
  sorry

theorem of_nat_iff {α : Type u_1} {β : Type u_2} [denumerable α] [primcodable β] {f : α → β} :
    primrec f ↔ primrec fun (n : ℕ) => f (denumerable.of_nat α n) :=
  iff.trans dom_denumerable (iff.trans (iff.symm nat_iff) encode_iff)

protected theorem of_nat (α : Type u_1) [denumerable α] : primrec (denumerable.of_nat α) :=
  iff.mp of_nat_iff primrec.id

theorem option_some_iff {α : Type u_1} {σ : Type u_3} [primcodable α] [primcodable σ] {f : α → σ} :
    (primrec fun (a : α) => some (f a)) ↔ primrec f :=
  { mp :=
      fun (h : primrec fun (a : α) => some (f a)) =>
        iff.mp encode_iff (comp pred (iff.mpr encode_iff h)),
    mpr := comp option_some }

theorem of_equiv {α : Type u_1} [primcodable α] {β : Type u_2} {e : β ≃ α} : primrec ⇑e :=
  iff.mp encode_iff primrec.encode

theorem of_equiv_symm {α : Type u_1} [primcodable α] {β : Type u_2} {e : β ≃ α} :
    primrec ⇑(equiv.symm e) :=
  sorry

theorem of_equiv_iff {α : Type u_1} {σ : Type u_3} [primcodable α] [primcodable σ] {β : Type u_2}
    (e : β ≃ α) {f : σ → β} : (primrec fun (a : σ) => coe_fn e (f a)) ↔ primrec f :=
  sorry

theorem of_equiv_symm_iff {α : Type u_1} {σ : Type u_3} [primcodable α] [primcodable σ]
    {β : Type u_2} (e : β ≃ α) {f : σ → α} :
    (primrec fun (a : σ) => coe_fn (equiv.symm e) (f a)) ↔ primrec f :=
  sorry

end primrec

namespace primcodable

protected instance prod {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] :
    primcodable (α × β) :=
  mk sorry

end primcodable

namespace primrec

theorem fst {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] : primrec prod.fst :=
  sorry

theorem snd {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] : primrec prod.snd :=
  sorry

theorem pair {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β]
    [primcodable γ] {f : α → β} {g : α → γ} (hf : primrec f) (hg : primrec g) :
    primrec fun (a : α) => (f a, g a) :=
  sorry

theorem unpair : primrec nat.unpair := sorry

theorem list_nth₁ {α : Type u_1} [primcodable α] (l : List α) : primrec (list.nth l) := sorry

end primrec

/-- `primrec₂ f` means `f` is a binary primitive recursive function.
  This is technically unnecessary since we can always curry all
  the arguments together, but there are enough natural two-arg
  functions that it is convenient to express this directly. -/
def primrec₂ {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] (f : α → β → σ) :=
  primrec fun (p : α × β) => f (prod.fst p) (prod.snd p)

/-- `primrec_pred p` means `p : α → Prop` is a (decidable)
  primitive recursive predicate, which is to say that
  `to_bool ∘ p : α → bool` is primitive recursive. -/
def primrec_pred {α : Type u_1} [primcodable α] (p : α → Prop) [decidable_pred p] :=
  primrec fun (a : α) => to_bool (p a)

/-- `primrec_rel p` means `p : α → β → Prop` is a (decidable)
  primitive recursive relation, which is to say that
  `to_bool ∘ p : α → β → bool` is primitive recursive. -/
def primrec_rel {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (s : α → β → Prop)
    [(a : α) → (b : β) → Decidable (s a b)] :=
  primrec₂ fun (a : α) (b : β) => to_bool (s a b)

namespace primrec₂

theorem of_eq {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → β → σ} {g : α → β → σ} (hg : primrec₂ f)
    (H : ∀ (a : α) (b : β), f a b = g a b) : primrec₂ g :=
  (funext fun (a : α) => funext fun (b : β) => H a b) ▸ hg

theorem const {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] (x : σ) : primrec₂ fun (a : α) (b : β) => x :=
  primrec.const x

protected theorem pair {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] :
    primrec₂ Prod.mk :=
  primrec.pair primrec.fst primrec.snd

theorem left {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] :
    primrec₂ fun (a : α) (b : β) => a :=
  primrec.fst

theorem right {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] :
    primrec₂ fun (a : α) (b : β) => b :=
  primrec.snd

theorem mkpair : primrec₂ nat.mkpair := sorry

theorem unpaired {α : Type u_1} [primcodable α] {f : ℕ → ℕ → α} :
    primrec (nat.unpaired f) ↔ primrec₂ f :=
  sorry

theorem unpaired' {f : ℕ → ℕ → ℕ} : nat.primrec (nat.unpaired f) ↔ primrec₂ f :=
  iff.trans (iff.symm primrec.nat_iff) unpaired

theorem encode_iff {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → β → σ} :
    (primrec₂ fun (a : α) (b : β) => encodable.encode (f a b)) ↔ primrec₂ f :=
  primrec.encode_iff

theorem option_some_iff {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → β → σ} : (primrec₂ fun (a : α) (b : β) => some (f a b)) ↔ primrec₂ f :=
  primrec.option_some_iff

theorem of_nat_iff {α : Type u_1} {β : Type u_2} {σ : Type u_3} [denumerable α] [denumerable β]
    [primcodable σ] {f : α → β → σ} :
    primrec₂ f ↔ primrec₂ fun (m n : ℕ) => f (denumerable.of_nat α m) (denumerable.of_nat β n) :=
  sorry

theorem uncurry {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → β → σ} : primrec (function.uncurry f) ↔ primrec₂ f :=
  sorry

theorem curry {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] {f : α × β → σ} : primrec₂ (function.curry f) ↔ primrec f :=
  sorry

end primrec₂

theorem primrec.comp₂ {α : Type u_1} {β : Type u_2} {γ : Type u_3} {σ : Type u_5} [primcodable α]
    [primcodable β] [primcodable γ] [primcodable σ] {f : γ → σ} {g : α → β → γ} (hf : primrec f)
    (hg : primrec₂ g) : primrec₂ fun (a : α) (b : β) => f (g a b) :=
  primrec.comp hf hg

theorem primrec₂.comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} {σ : Type u_5} [primcodable α]
    [primcodable β] [primcodable γ] [primcodable σ] {f : β → γ → σ} {g : α → β} {h : α → γ}
    (hf : primrec₂ f) (hg : primrec g) (hh : primrec h) : primrec fun (a : α) => f (g a) (h a) :=
  primrec.comp hf (primrec.pair hg hh)

theorem primrec₂.comp₂ {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} {σ : Type u_5}
    [primcodable α] [primcodable β] [primcodable γ] [primcodable δ] [primcodable σ] {f : γ → δ → σ}
    {g : α → β → γ} {h : α → β → δ} (hf : primrec₂ f) (hg : primrec₂ g) (hh : primrec₂ h) :
    primrec₂ fun (a : α) (b : β) => f (g a b) (h a b) :=
  primrec₂.comp hf hg hh

theorem primrec_pred.comp {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {p : β → Prop} [decidable_pred p] {f : α → β} :
    primrec_pred p → primrec f → primrec_pred fun (a : α) => p (f a) :=
  primrec.comp

theorem primrec_rel.comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α]
    [primcodable β] [primcodable γ] {R : β → γ → Prop} [(a : β) → (b : γ) → Decidable (R a b)]
    {f : α → β} {g : α → γ} :
    primrec_rel R → primrec f → primrec g → primrec_pred fun (a : α) => R (f a) (g a) :=
  primrec₂.comp

theorem primrec_rel.comp₂ {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4}
    [primcodable α] [primcodable β] [primcodable γ] [primcodable δ] {R : γ → δ → Prop}
    [(a : γ) → (b : δ) → Decidable (R a b)] {f : α → β → γ} {g : α → β → δ} :
    primrec_rel R →
        primrec₂ f → primrec₂ g → primrec_rel fun (a : α) (b : β) => R (f a b) (g a b) :=
  primrec_rel.comp

theorem primrec_pred.of_eq {α : Type u_1} [primcodable α] {p : α → Prop} {q : α → Prop}
    [decidable_pred p] [decidable_pred q] (hp : primrec_pred p) (H : ∀ (a : α), p a ↔ q a) :
    primrec_pred q :=
  primrec.of_eq hp fun (a : α) => to_bool_congr (H a)

theorem primrec_rel.of_eq {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {r : α → β → Prop} {s : α → β → Prop} [(a : α) → (b : β) → Decidable (r a b)]
    [(a : α) → (b : β) → Decidable (s a b)] (hr : primrec_rel r)
    (H : ∀ (a : α) (b : β), r a b ↔ s a b) : primrec_rel s :=
  primrec₂.of_eq hr fun (a : α) (b : β) => to_bool_congr (H a b)

namespace primrec₂

theorem swap {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → β → σ} (h : primrec₂ f) : primrec₂ (function.swap f) :=
  comp₂ h right left

theorem nat_iff {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → β → σ} :
    primrec₂ f ↔
        nat.primrec
          (nat.unpaired
            fun (m n : ℕ) =>
              encodable.encode
                (option.bind (encodable.decode α m)
                  fun (a : α) => option.map (f a) (encodable.decode β n))) :=
  sorry

theorem nat_iff' {α : Type u_1} {β : Type u_2} {σ : Type u_3} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → β → σ} :
    primrec₂ f ↔
        primrec₂
          fun (m n : ℕ) =>
            option.bind (encodable.decode α m)
              fun (a : α) => option.map (f a) (encodable.decode β n) :=
  iff.trans nat_iff (iff.trans unpaired' encode_iff)

end primrec₂

namespace primrec

theorem to₂ {α : Type u_1} {β : Type u_2} {σ : Type u_5} [primcodable α] [primcodable β]
    [primcodable σ] {f : α × β → σ} (hf : primrec f) : primrec₂ fun (a : α) (b : β) => f (a, b) :=
  of_eq hf
    fun (_x : α × β) =>
      (fun (_a : α × β) =>
          prod.cases_on _a fun (fst : α) (snd : β) => idRhs (f (fst, snd) = f (fst, snd)) rfl)
        _x

theorem nat_elim {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {f : α → β}
    {g : α → ℕ × β → β} (hf : primrec f) (hg : primrec₂ g) :
    primrec₂ fun (a : α) (n : ℕ) => nat.elim (f a) (fun (n : ℕ) (IH : β) => g a (n, IH)) n :=
  sorry

theorem nat_elim' {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {f : α → ℕ}
    {g : α → β} {h : α → ℕ × β → β} (hf : primrec f) (hg : primrec g) (hh : primrec₂ h) :
    primrec fun (a : α) => nat.elim (g a) (fun (n : ℕ) (IH : β) => h a (n, IH)) (f a) :=
  primrec₂.comp (nat_elim hg hh) primrec.id hf

theorem nat_elim₁ {α : Type u_1} [primcodable α] {f : ℕ → α → α} (a : α) (hf : primrec₂ f) :
    primrec (nat.elim a f) :=
  nat_elim' primrec.id (const a) (comp₂ hf primrec₂.right)

theorem nat_cases' {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {f : α → β}
    {g : α → ℕ → β} (hf : primrec f) (hg : primrec₂ g) :
    primrec₂ fun (a : α) => nat.cases (f a) (g a) :=
  nat_elim hf (primrec₂.comp₂ hg primrec₂.left (comp₂ fst primrec₂.right))

theorem nat_cases {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {f : α → ℕ}
    {g : α → β} {h : α → ℕ → β} (hf : primrec f) (hg : primrec g) (hh : primrec₂ h) :
    primrec fun (a : α) => nat.cases (g a) (h a) (f a) :=
  primrec₂.comp (nat_cases' hg hh) primrec.id hf

theorem nat_cases₁ {α : Type u_1} [primcodable α] {f : ℕ → α} (a : α) (hf : primrec f) :
    primrec (nat.cases a f) :=
  nat_cases primrec.id (const a) (comp₂ hf primrec₂.right)

theorem nat_iterate {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {f : α → ℕ}
    {g : α → β} {h : α → β → β} (hf : primrec f) (hg : primrec g) (hh : primrec₂ h) :
    primrec fun (a : α) => nat.iterate (h a) (f a) (g a) :=
  sorry

theorem option_cases {α : Type u_1} {β : Type u_2} {σ : Type u_5} [primcodable α] [primcodable β]
    [primcodable σ] {o : α → Option β} {f : α → σ} {g : α → β → σ} (ho : primrec o) (hf : primrec f)
    (hg : primrec₂ g) : primrec fun (a : α) => option.cases_on (o a) (f a) (g a) :=
  sorry

theorem option_bind {α : Type u_1} {β : Type u_2} {σ : Type u_5} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → Option β} {g : α → β → Option σ} (hf : primrec f) (hg : primrec₂ g) :
    primrec fun (a : α) => option.bind (f a) (g a) :=
  sorry

theorem option_bind₁ {α : Type u_1} {σ : Type u_5} [primcodable α] [primcodable σ]
    {f : α → Option σ} (hf : primrec f) : primrec fun (o : Option α) => option.bind o f :=
  option_bind primrec.id (to₂ (comp hf snd))

theorem option_map {α : Type u_1} {β : Type u_2} {σ : Type u_5} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → Option β} {g : α → β → σ} (hf : primrec f) (hg : primrec₂ g) :
    primrec fun (a : α) => option.map (g a) (f a) :=
  option_bind hf (comp₂ option_some hg)

theorem option_map₁ {α : Type u_1} {σ : Type u_5} [primcodable α] [primcodable σ] {f : α → σ}
    (hf : primrec f) : primrec (option.map f) :=
  option_map primrec.id (to₂ (comp hf snd))

theorem option_iget {α : Type u_1} [primcodable α] [Inhabited α] : primrec option.iget := sorry

theorem option_is_some {α : Type u_1} [primcodable α] : primrec option.is_some := sorry

theorem option_get_or_else {α : Type u_1} [primcodable α] : primrec₂ option.get_or_else := sorry

theorem bind_decode_iff {α : Type u_1} {β : Type u_2} {σ : Type u_5} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → β → Option σ} :
    (primrec₂ fun (a : α) (n : ℕ) => option.bind (encodable.decode β n) (f a)) ↔ primrec₂ f :=
  sorry

theorem map_decode_iff {α : Type u_1} {β : Type u_2} {σ : Type u_5} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → β → σ} :
    (primrec₂ fun (a : α) (n : ℕ) => option.map (f a) (encodable.decode β n)) ↔ primrec₂ f :=
  iff.trans bind_decode_iff primrec₂.option_some_iff

theorem nat_add : primrec₂ Add.add := iff.mp primrec₂.unpaired' nat.primrec.add

theorem nat_sub : primrec₂ Sub.sub := iff.mp primrec₂.unpaired' nat.primrec.sub

theorem nat_mul : primrec₂ Mul.mul := iff.mp primrec₂.unpaired' nat.primrec.mul

theorem cond {α : Type u_1} {σ : Type u_5} [primcodable α] [primcodable σ] {c : α → Bool}
    {f : α → σ} {g : α → σ} (hc : primrec c) (hf : primrec f) (hg : primrec g) :
    primrec fun (a : α) => cond (c a) (f a) (g a) :=
  sorry

theorem ite {α : Type u_1} {σ : Type u_5} [primcodable α] [primcodable σ] {c : α → Prop}
    [decidable_pred c] {f : α → σ} {g : α → σ} (hc : primrec_pred c) (hf : primrec f)
    (hg : primrec g) : primrec fun (a : α) => ite (c a) (f a) (g a) :=
  sorry

theorem nat_le : primrec_rel LessEq := sorry

theorem nat_min : primrec₂ min := ite nat_le fst snd

theorem nat_max : primrec₂ max := ite (primrec_rel.comp nat_le snd fst) fst snd

theorem dom_bool {α : Type u_1} [primcodable α] (f : Bool → α) : primrec f :=
  of_eq (cond primrec.id (const (f tt)) (const (f false)))
    fun (b : Bool) =>
      bool.cases_on b (Eq.refl (cond (id false) (f tt) (f false)))
        (Eq.refl (cond (id tt) (f tt) (f false)))

theorem dom_bool₂ {α : Type u_1} [primcodable α] (f : Bool → Bool → α) : primrec₂ f := sorry

protected theorem bnot : primrec bnot := dom_bool bnot

protected theorem band : primrec₂ band := dom_bool₂ band

protected theorem bor : primrec₂ bor := dom_bool₂ bor

protected theorem not {α : Type u_1} [primcodable α] {p : α → Prop} [decidable_pred p]
    (hp : primrec_pred p) : primrec_pred fun (a : α) => ¬p a :=
  sorry

protected theorem and {α : Type u_1} [primcodable α] {p : α → Prop} {q : α → Prop}
    [decidable_pred p] [decidable_pred q] (hp : primrec_pred p) (hq : primrec_pred q) :
    primrec_pred fun (a : α) => p a ∧ q a :=
  sorry

protected theorem or {α : Type u_1} [primcodable α] {p : α → Prop} {q : α → Prop} [decidable_pred p]
    [decidable_pred q] (hp : primrec_pred p) (hq : primrec_pred q) :
    primrec_pred fun (a : α) => p a ∨ q a :=
  sorry

protected theorem eq {α : Type u_1} [primcodable α] [DecidableEq α] : primrec_rel Eq := sorry

theorem nat_lt : primrec_rel Less := sorry

theorem option_guard {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {p : α → β → Prop} [(a : α) → (b : β) → Decidable (p a b)] (hp : primrec_rel p) {f : α → β}
    (hf : primrec f) : primrec fun (a : α) => option.guard (p a) (f a) :=
  ite (primrec_rel.comp hp primrec.id hf) (iff.mpr option_some_iff hf) (const none)

theorem option_orelse {α : Type u_1} [primcodable α] : primrec₂ has_orelse.orelse := sorry

protected theorem decode2 {α : Type u_1} [primcodable α] : primrec (encodable.decode2 α) :=
  option_bind primrec.decode
    (option_guard (primrec_rel.comp primrec.eq (iff.mpr encode_iff snd) (comp fst fst)) snd)

theorem list_find_index₁ {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {p : α → β → Prop} [(a : α) → (b : β) → Decidable (p a b)] (hp : primrec_rel p) (l : List β) :
    primrec fun (a : α) => list.find_index (p a) l :=
  sorry

theorem list_index_of₁ {α : Type u_1} [primcodable α] [DecidableEq α] (l : List α) :
    primrec fun (a : α) => list.index_of a l :=
  list_find_index₁ primrec.eq l

theorem dom_fintype {α : Type u_1} {σ : Type u_5} [primcodable α] [primcodable σ] [fintype α]
    (f : α → σ) : primrec f :=
  sorry

theorem nat_bodd_div2 : primrec nat.bodd_div2 := sorry

theorem nat_bodd : primrec nat.bodd := comp fst nat_bodd_div2

theorem nat_div2 : primrec nat.div2 := comp snd nat_bodd_div2

theorem nat_bit0 : primrec bit0 := primrec₂.comp nat_add primrec.id primrec.id

theorem nat_bit1 : primrec bit1 := primrec₂.comp nat_add nat_bit0 (const 1)

theorem nat_bit : primrec₂ nat.bit := sorry

theorem nat_div_mod : primrec₂ fun (n k : ℕ) => (n / k, n % k) := sorry

theorem nat_div : primrec₂ Div.div := comp₂ fst nat_div_mod

theorem nat_mod : primrec₂ Mod.mod := comp₂ snd nat_div_mod

end primrec

namespace primcodable

protected instance sum {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] :
    primcodable (α ⊕ β) :=
  mk sorry

protected instance list {α : Type u_1} [primcodable α] : primcodable (List α) := mk sorry

end primcodable

namespace primrec

theorem sum_inl {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] : primrec sum.inl :=
  iff.mp encode_iff (comp nat_bit0 primrec.encode)

theorem sum_inr {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] : primrec sum.inr :=
  iff.mp encode_iff (comp nat_bit1 primrec.encode)

theorem sum_cases {α : Type u_1} {β : Type u_2} {γ : Type u_3} {σ : Type u_4} [primcodable α]
    [primcodable β] [primcodable γ] [primcodable σ] {f : α → β ⊕ γ} {g : α → β → σ} {h : α → γ → σ}
    (hf : primrec f) (hg : primrec₂ g) (hh : primrec₂ h) :
    primrec fun (a : α) => sum.cases_on (f a) (g a) (h a) :=
  sorry

theorem list_cons {α : Type u_1} [primcodable α] : primrec₂ List.cons :=
  list_cons' (primcodable.prim (List α))

theorem list_cases {α : Type u_1} {β : Type u_2} {σ : Type u_4} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → List β} {g : α → σ} {h : α → β × List β → σ} :
    primrec f →
        primrec g →
          primrec₂ h →
            primrec
              fun (a : α) => list.cases_on (f a) (g a) fun (b : β) (l : List β) => h a (b, l) :=
  list_cases' (primcodable.prim (List β))

theorem list_foldl {α : Type u_1} {β : Type u_2} {σ : Type u_4} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → List β} {g : α → σ} {h : α → σ × β → σ} :
    primrec f →
        primrec g →
          primrec₂ h →
            primrec fun (a : α) => list.foldl (fun (s : σ) (b : β) => h a (s, b)) (g a) (f a) :=
  list_foldl' (primcodable.prim (List β))

theorem list_reverse {α : Type u_1} [primcodable α] : primrec list.reverse :=
  list_reverse' (primcodable.prim (List α))

theorem list_foldr {α : Type u_1} {β : Type u_2} {σ : Type u_4} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → List β} {g : α → σ} {h : α → β × σ → σ} (hf : primrec f)
    (hg : primrec g) (hh : primrec₂ h) :
    primrec fun (a : α) => list.foldr (fun (b : β) (s : σ) => h a (b, s)) (g a) (f a) :=
  sorry

theorem list_head' {α : Type u_1} [primcodable α] : primrec list.head' := sorry

theorem list_head {α : Type u_1} [primcodable α] [Inhabited α] : primrec list.head :=
  of_eq (comp option_iget list_head') fun (l : List α) => Eq.symm (list.head_eq_head' l)

theorem list_tail {α : Type u_1} [primcodable α] : primrec list.tail := sorry

theorem list_rec {α : Type u_1} {β : Type u_2} {σ : Type u_4} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → List β} {g : α → σ} {h : α → β × List β × σ → σ} (hf : primrec f)
    (hg : primrec g) (hh : primrec₂ h) :
    primrec
        fun (a : α) =>
          list.rec_on (f a) (g a) fun (b : β) (l : List β) (IH : σ) => h a (b, l, IH) :=
  sorry

theorem list_nth {α : Type u_1} [primcodable α] : primrec₂ list.nth := sorry

theorem list_inth {α : Type u_1} [primcodable α] [Inhabited α] : primrec₂ list.inth :=
  comp₂ option_iget list_nth

theorem list_append {α : Type u_1} [primcodable α] : primrec₂ append := sorry

theorem list_concat {α : Type u_1} [primcodable α] :
    primrec₂ fun (l : List α) (a : α) => l ++ [a] :=
  primrec₂.comp list_append fst (primrec₂.comp list_cons snd (const []))

theorem list_map {α : Type u_1} {β : Type u_2} {σ : Type u_4} [primcodable α] [primcodable β]
    [primcodable σ] {f : α → List β} {g : α → β → σ} (hf : primrec f) (hg : primrec₂ g) :
    primrec fun (a : α) => list.map (g a) (f a) :=
  sorry

theorem list_range : primrec list.range := sorry

theorem list_join {α : Type u_1} [primcodable α] : primrec list.join := sorry

theorem list_length {α : Type u_1} [primcodable α] : primrec list.length := sorry

theorem list_find_index {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β]
    {f : α → List β} {p : α → β → Prop} [(a : α) → (b : β) → Decidable (p a b)] (hf : primrec f)
    (hp : primrec_rel p) : primrec fun (a : α) => list.find_index (p a) (f a) :=
  sorry

theorem list_index_of {α : Type u_1} [primcodable α] [DecidableEq α] : primrec₂ list.index_of :=
  to₂ (list_find_index snd (primrec_rel.comp₂ primrec.eq (to₂ (comp fst fst)) (to₂ snd)))

theorem nat_strong_rec {α : Type u_1} {σ : Type u_4} [primcodable α] [primcodable σ] (f : α → ℕ → σ)
    {g : α → List σ → Option σ} (hg : primrec₂ g)
    (H : ∀ (a : α) (n : ℕ), g a (list.map (f a) (list.range n)) = some (f a n)) : primrec₂ f :=
  sorry

end primrec

namespace primcodable

def subtype {α : Type u_1} [primcodable α] {p : α → Prop} [decidable_pred p] (hp : primrec_pred p) :
    primcodable (Subtype p) :=
  mk sorry

protected instance fin {n : ℕ} : primcodable (fin n) :=
  of_equiv (Subtype fun (a : ℕ) => id a < n) (equiv.fin_equiv_subtype n)

protected instance vector {α : Type u_1} [primcodable α] {n : ℕ} : primcodable (vector α n) :=
  subtype sorry

protected instance fin_arrow {α : Type u_1} [primcodable α] {n : ℕ} : primcodable (fin n → α) :=
  of_equiv (vector α n) (equiv.symm (equiv.vector_equiv_fin α n))

protected instance array {α : Type u_1} [primcodable α] {n : ℕ} : primcodable (array n α) :=
  of_equiv (fin n → α) (equiv.array_equiv_fin n α)

protected instance ulower {α : Type u_1} [primcodable α] : primcodable (ulower α) :=
  (fun (this : primrec_pred fun (n : ℕ) => encodable.decode2 α n ≠ none) => subtype sorry) sorry

end primcodable

namespace primrec

theorem subtype_val {α : Type u_1} [primcodable α] {p : α → Prop} [decidable_pred p]
    {hp : primrec_pred p} : primrec subtype.val :=
  sorry

theorem subtype_val_iff {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : β → Prop}
    [decidable_pred p] {hp : primrec_pred p} {f : α → Subtype p} :
    (primrec fun (a : α) => subtype.val (f a)) ↔ primrec f :=
  sorry

theorem subtype_mk {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : β → Prop}
    [decidable_pred p] {hp : primrec_pred p} {f : α → β} {h : ∀ (a : α), p (f a)} (hf : primrec f) :
    primrec fun (a : α) => { val := f a, property := h a } :=
  iff.mp subtype_val_iff hf

theorem option_get {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {f : α → Option β}
    {h : ∀ (a : α), ↥(option.is_some (f a))} :
    primrec f → primrec fun (a : α) => option.get (h a) :=
  sorry

theorem ulower_down {α : Type u_1} [primcodable α] : primrec ulower.down :=
  subtype_mk primrec.encode

theorem ulower_up {α : Type u_1} [primcodable α] : primrec ulower.up :=
  option_get (comp primrec.decode2 subtype_val)

theorem fin_val_iff {α : Type u_1} [primcodable α] {n : ℕ} {f : α → fin n} :
    (primrec fun (a : α) => subtype.val (f a)) ↔ primrec f :=
  iff.trans (iff.trans (iff.refl (primrec fun (a : α) => subtype.val (f a))) subtype_val_iff)
    (of_equiv_iff (equiv.fin_equiv_subtype n))

theorem fin_val {n : ℕ} : primrec coe := iff.mpr fin_val_iff primrec.id

theorem fin_succ {n : ℕ} : primrec fin.succ := sorry

theorem vector_to_list {α : Type u_1} [primcodable α] {n : ℕ} : primrec vector.to_list :=
  subtype_val

theorem vector_to_list_iff {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {n : ℕ}
    {f : α → vector β n} : (primrec fun (a : α) => vector.to_list (f a)) ↔ primrec f :=
  subtype_val_iff

theorem vector_cons {α : Type u_1} [primcodable α] {n : ℕ} : primrec₂ vector.cons := sorry

theorem vector_length {α : Type u_1} [primcodable α] {n : ℕ} : primrec vector.length := const n

theorem vector_head {α : Type u_1} [primcodable α] {n : ℕ} : primrec vector.head := sorry

theorem vector_tail {α : Type u_1} [primcodable α] {n : ℕ} : primrec vector.tail := sorry

theorem vector_nth {α : Type u_1} [primcodable α] {n : ℕ} : primrec₂ vector.nth := sorry

theorem list_of_fn {α : Type u_1} {σ : Type u_4} [primcodable α] [primcodable σ] {n : ℕ}
    {f : fin n → α → σ} :
    (∀ (i : fin n), primrec (f i)) → primrec fun (a : α) => list.of_fn fun (i : fin n) => f i a :=
  sorry

theorem vector_of_fn {α : Type u_1} {σ : Type u_4} [primcodable α] [primcodable σ] {n : ℕ}
    {f : fin n → α → σ} (hf : ∀ (i : fin n), primrec (f i)) :
    primrec fun (a : α) => vector.of_fn fun (i : fin n) => f i a :=
  sorry

theorem vector_nth' {α : Type u_1} [primcodable α] {n : ℕ} : primrec vector.nth := of_equiv_symm

theorem vector_of_fn' {α : Type u_1} [primcodable α] {n : ℕ} : primrec vector.of_fn := of_equiv

theorem fin_app {σ : Type u_4} [primcodable σ] {n : ℕ} : primrec₂ id := sorry

theorem fin_curry₁ {α : Type u_1} {σ : Type u_4} [primcodable α] [primcodable σ] {n : ℕ}
    {f : fin n → α → σ} : primrec₂ f ↔ ∀ (i : fin n), primrec (f i) :=
  sorry

theorem fin_curry {α : Type u_1} {σ : Type u_4} [primcodable α] [primcodable σ] {n : ℕ}
    {f : α → fin n → σ} : primrec f ↔ primrec₂ f :=
  sorry

end primrec

namespace nat

/-- An alternative inductive definition of `primrec` which
  does not use the pairing function on ℕ, and so has to
  work with n-ary functions on ℕ instead of unary functions.
  We prove that this is equivalent to the regular notion
  in `to_prim` and `of_prim`. -/
inductive primrec' : {n : ℕ} → (vector ℕ n → ℕ) → Prop where
| zero : primrec' fun (_x : vector ℕ 0) => 0
| succ : primrec' fun (v : vector ℕ 1) => Nat.succ (vector.head v)
| nth : ∀ {n : ℕ} (i : fin n), primrec' fun (v : vector ℕ n) => vector.nth v i
| comp :
    ∀ {m n : ℕ} {f : vector ℕ n → ℕ} (g : fin n → vector ℕ m → ℕ),
      primrec' f →
        (∀ (i : fin n), primrec' (g i)) →
          primrec' fun (a : vector ℕ m) => f (vector.of_fn fun (i : fin n) => g i a)
| prec :
    ∀ {n : ℕ} {f : vector ℕ n → ℕ} {g : vector ℕ (n + bit0 1) → ℕ},
      primrec' f →
        primrec' g →
          primrec'
            fun (v : vector ℕ (n + 1)) =>
              elim (f (vector.tail v)) (fun (y IH : ℕ) => g (y::ᵥIH::ᵥvector.tail v))
                (vector.head v)

end nat

namespace nat.primrec'

theorem to_prim {n : ℕ} {f : vector ℕ n → ℕ} (pf : primrec' f) : primrec f := sorry

theorem of_eq {n : ℕ} {f : vector ℕ n → ℕ} {g : vector ℕ n → ℕ} (hf : primrec' f)
    (H : ∀ (i : vector ℕ n), f i = g i) : primrec' g :=
  funext H ▸ hf

theorem const {n : ℕ} (m : ℕ) : primrec' fun (v : vector ℕ n) => m := sorry

theorem head {n : ℕ} : primrec' vector.head := sorry

theorem tail {n : ℕ} {f : vector ℕ n → ℕ} (hf : primrec' f) :
    primrec' fun (v : vector ℕ (Nat.succ n)) => f (vector.tail v) :=
  sorry

def vec {n : ℕ} {m : ℕ} (f : vector ℕ n → vector ℕ m) :=
  ∀ (i : fin m), primrec' fun (v : vector ℕ n) => vector.nth (f v) i

protected theorem nil {n : ℕ} : vec fun (_x : vector ℕ n) => vector.nil :=
  fun (i : fin 0) => fin.elim0 i

protected theorem cons {n : ℕ} {m : ℕ} {f : vector ℕ n → ℕ} {g : vector ℕ n → vector ℕ m}
    (hf : primrec' f) (hg : vec g) : vec fun (v : vector ℕ n) => f v::ᵥg v :=
  sorry

theorem idv {n : ℕ} : vec id := nth

theorem comp' {n : ℕ} {m : ℕ} {f : vector ℕ m → ℕ} {g : vector ℕ n → vector ℕ m} (hf : primrec' f)
    (hg : vec g) : primrec' fun (v : vector ℕ n) => f (g v) :=
  sorry

theorem comp₁ (f : ℕ → ℕ) (hf : primrec' fun (v : vector ℕ 1) => f (vector.head v)) {n : ℕ}
    {g : vector ℕ n → ℕ} (hg : primrec' g) : primrec' fun (v : vector ℕ n) => f (g v) :=
  comp (fun (i : fin 1) => g) hf fun (i : fin 1) => hg

theorem comp₂ (f : ℕ → ℕ → ℕ)
    (hf : primrec' fun (v : vector ℕ (bit0 1)) => f (vector.head v) (vector.head (vector.tail v)))
    {n : ℕ} {g : vector ℕ n → ℕ} {h : vector ℕ n → ℕ} (hg : primrec' g) (hh : primrec' h) :
    primrec' fun (v : vector ℕ n) => f (g v) (h v) :=
  sorry

theorem prec' {n : ℕ} {f : vector ℕ n → ℕ} {g : vector ℕ n → ℕ} {h : vector ℕ (n + bit0 1) → ℕ}
    (hf : primrec' f) (hg : primrec' g) (hh : primrec' h) :
    primrec' fun (v : vector ℕ n) => elim (g v) (fun (y IH : ℕ) => h (y::ᵥIH::ᵥv)) (f v) :=
  sorry

theorem pred : primrec' fun (v : vector ℕ 1) => Nat.pred (vector.head v) := sorry

theorem add : primrec' fun (v : vector ℕ (bit0 1)) => vector.head v + vector.head (vector.tail v) :=
  sorry

theorem sub : primrec' fun (v : vector ℕ (bit0 1)) => vector.head v - vector.head (vector.tail v) :=
  sorry

theorem mul : primrec' fun (v : vector ℕ (bit0 1)) => vector.head v * vector.head (vector.tail v) :=
  sorry

theorem if_lt {n : ℕ} {a : vector ℕ n → ℕ} {b : vector ℕ n → ℕ} {f : vector ℕ n → ℕ}
    {g : vector ℕ n → ℕ} (ha : primrec' a) (hb : primrec' b) (hf : primrec' f) (hg : primrec' g) :
    primrec' fun (v : vector ℕ n) => ite (a v < b v) (f v) (g v) :=
  sorry

theorem mkpair :
    primrec' fun (v : vector ℕ (bit0 1)) => mkpair (vector.head v) (vector.head (vector.tail v)) :=
  if_lt head (tail head) (comp₂ Add.add add (tail (comp₂ Mul.mul mul head head)) head)
    (comp₂ Add.add add (comp₂ Add.add add (comp₂ Mul.mul mul head head) head) (tail head))

protected theorem encode {n : ℕ} : primrec' encodable.encode := sorry

theorem sqrt : primrec' fun (v : vector ℕ 1) => sqrt (vector.head v) := sorry

theorem unpair₁ {n : ℕ} {f : vector ℕ n → ℕ} (hf : primrec' f) :
    primrec' fun (v : vector ℕ n) => prod.fst (unpair (f v)) :=
  sorry

theorem unpair₂ {n : ℕ} {f : vector ℕ n → ℕ} (hf : primrec' f) :
    primrec' fun (v : vector ℕ n) => prod.snd (unpair (f v)) :=
  sorry

theorem of_prim {n : ℕ} {f : vector ℕ n → ℕ} : primrec f → primrec' f := sorry

theorem prim_iff {n : ℕ} {f : vector ℕ n → ℕ} : primrec' f ↔ primrec f :=
  { mp := to_prim, mpr := of_prim }

theorem prim_iff₁ {f : ℕ → ℕ} : (primrec' fun (v : vector ℕ 1) => f (vector.head v)) ↔ primrec f :=
  sorry

theorem prim_iff₂ {f : ℕ → ℕ → ℕ} :
    (primrec' fun (v : vector ℕ (bit0 1)) => f (vector.head v) (vector.head (vector.tail v))) ↔
        primrec₂ f :=
  sorry

theorem vec_iff {m : ℕ} {n : ℕ} {f : vector ℕ m → vector ℕ n} : vec f ↔ primrec f := sorry

end nat.primrec'

theorem primrec.nat_sqrt : primrec nat.sqrt := iff.mp nat.primrec'.prim_iff₁ nat.primrec'.sqrt

end Mathlib


/-
Copyright (c) 2017 Simon Hudon All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Mario Carneiro
-/
import data.rat.cast
import data.rat.meta_defs

/-!
# `norm_num`

Evaluating arithmetic expressions including `*`, `+`, `-`, `^`, `≤`.
-/

universes u v w

namespace tactic

/-- Reflexivity conversion: given `e` returns `(e, ⊢ e = e)` -/
meta def refl_conv (e : expr) : tactic (expr × expr) :=
do p ← mk_eq_refl e, return (e, p)

/-- Turns a conversion tactic into one that always succeeds, where failure is interpreted as a
proof by reflexivity. -/
meta def or_refl_conv (tac : expr → tactic (expr × expr))
  (e : expr) : tactic (expr × expr) := tac e <|> refl_conv e

/-- Transitivity conversion: given two conversions (which take an
expression `e` and returns `(e', ⊢ e = e')`), produces another
conversion that combines them with transitivity, treating failures
as reflexivity conversions. -/
meta def trans_conv (t₁ t₂ : expr → tactic (expr × expr)) (e : expr) :
  tactic (expr × expr) :=
(do (e₁, p₁) ← t₁ e,
  (do (e₂, p₂) ← t₂ e₁,
    p ← mk_eq_trans p₁ p₂, return (e₂, p)) <|>
  return (e₁, p₁)) <|> t₂ e

namespace instance_cache

/-- Faster version of `mk_app ``bit0 [e]`. -/
meta def mk_bit0 (c : instance_cache) (e : expr) : tactic (instance_cache × expr) :=
do (c, ai) ← c.get ``has_add,
   return (c, (expr.const ``bit0 [c.univ]).mk_app [c.α, ai, e])

/-- Faster version of `mk_app ``bit1 [e]`. -/
meta def mk_bit1 (c : instance_cache) (e : expr) : tactic (instance_cache × expr) :=
do (c, ai) ← c.get ``has_add,
   (c, oi) ← c.get ``has_one,
   return (c, (expr.const ``bit1 [c.univ]).mk_app [c.α, oi, ai, e])

end instance_cache

end tactic

open tactic

/-!
Each lemma in this file is written the way it is to exactly match (with no defeq reduction allowed)
the conclusion of some lemma generated by the proof procedure that uses it. That proof procedure
should describe the shape of the generated lemma in its docstring.
-/

namespace norm_num
variable {α : Type u}

lemma subst_into_add {α} [has_add α] (l r tl tr t)
  (prl : (l : α) = tl) (prr : r = tr) (prt : tl + tr = t) : l + r = t :=
by rw [prl, prr, prt]

lemma subst_into_mul {α} [has_mul α] (l r tl tr t)
  (prl : (l : α) = tl) (prr : r = tr) (prt : tl * tr = t) : l * r = t :=
by rw [prl, prr, prt]

lemma subst_into_neg {α} [has_neg α] (a ta t : α) (pra : a = ta) (prt : -ta = t) : -a = t :=
by simp [pra, prt]

/-- The result type of `match_numeral`, either `0`, `1`, or a top level
decomposition of `bit0 e` or `bit1 e`. The `other` case means it is not a numeral. -/
meta inductive match_numeral_result
| zero | one | bit0 (e : expr) | bit1 (e : expr) | other

/-- Unfold the top level constructor of the numeral expression. -/
meta def match_numeral : expr → match_numeral_result
| `(bit0 %%e) := match_numeral_result.bit0 e
| `(bit1 %%e) := match_numeral_result.bit1 e
| `(@has_zero.zero _ _) := match_numeral_result.zero
| `(@has_one.one _ _) := match_numeral_result.one
| _ := match_numeral_result.other

theorem zero_succ {α} [semiring α] : (0 + 1 : α) = 1 := zero_add _
theorem one_succ {α} [semiring α] : (1 + 1 : α) = 2 := rfl
theorem bit0_succ {α} [semiring α] (a : α) : bit0 a + 1 = bit1 a := rfl
theorem bit1_succ {α} [semiring α] (a b : α) (h : a + 1 = b) : bit1 a + 1 = bit0 b :=
h ▸ by simp [bit1, bit0, add_left_comm, add_assoc]

section
open match_numeral_result

/-- Given `a`, `b` natural numerals, proves `⊢ a + 1 = b`, assuming that this is provable.
(It may prove garbage instead of failing if `a + 1 = b` is false.) -/
meta def prove_succ : instance_cache → expr → expr → tactic (instance_cache × expr)
| c e r := match match_numeral e with
  | zero := c.mk_app ``zero_succ []
  | one := c.mk_app ``one_succ []
  | bit0 e := c.mk_app ``bit0_succ [e]
  | bit1 e := do
    let r := r.app_arg,
    (c, p) ← prove_succ c e r,
    c.mk_app ``bit1_succ [e, r, p]
  | _ := failed
  end
end

/-- Given `a` natural numeral, returns `(b, ⊢ a + 1 = b)`. -/
meta def prove_succ' (c : instance_cache) (a : expr) : tactic (instance_cache × expr × expr) :=
do na ← a.to_nat,
  (c, b) ← c.of_nat (na + 1),
  (c, p) ← prove_succ c a b,
  return (c, b, p)

theorem zero_adc {α} [semiring α] (a b : α) (h : a + 1 = b) : 0 + a + 1 = b := by rwa zero_add
theorem adc_zero {α} [semiring α] (a b : α) (h : a + 1 = b) : a + 0 + 1 = b := by rwa add_zero
theorem one_add {α} [semiring α] (a b : α) (h : a + 1 = b) : 1 + a = b := by rwa add_comm
theorem add_bit0_bit0 {α} [semiring α] (a b c : α) (h : a + b = c) : bit0 a + bit0 b = bit0 c :=
h ▸ by simp [bit0, add_left_comm, add_assoc]
theorem add_bit0_bit1 {α} [semiring α] (a b c : α) (h : a + b = c) : bit0 a + bit1 b = bit1 c :=
h ▸ by simp [bit0, bit1, add_left_comm, add_assoc]
theorem add_bit1_bit0 {α} [semiring α] (a b c : α) (h : a + b = c) : bit1 a + bit0 b = bit1 c :=
h ▸ by simp [bit0, bit1, add_left_comm, add_comm, add_assoc]
theorem add_bit1_bit1 {α} [semiring α] (a b c : α) (h : a + b + 1 = c) : bit1 a + bit1 b = bit0 c :=
h ▸ by simp [bit0, bit1, add_left_comm, add_comm, add_assoc]
theorem adc_one_one {α} [semiring α] : (1 + 1 + 1 : α) = 3 := rfl
theorem adc_bit0_one {α} [semiring α] (a b : α) (h : a + 1 = b) : bit0 a + 1 + 1 = bit0 b :=
h ▸ by simp [bit0, add_left_comm, add_assoc]
theorem adc_one_bit0 {α} [semiring α] (a b : α) (h : a + 1 = b) : 1 + bit0 a + 1 = bit0 b :=
h ▸ by simp [bit0, add_left_comm, add_assoc]
theorem adc_bit1_one {α} [semiring α] (a b : α) (h : a + 1 = b) : bit1 a + 1 + 1 = bit1 b :=
h ▸ by simp [bit1, bit0, add_left_comm, add_assoc]
theorem adc_one_bit1 {α} [semiring α] (a b : α) (h : a + 1 = b) : 1 + bit1 a + 1 = bit1 b :=
h ▸ by simp [bit1, bit0, add_left_comm, add_assoc]
theorem adc_bit0_bit0 {α} [semiring α] (a b c : α) (h : a + b = c) : bit0 a + bit0 b + 1 = bit1 c :=
h ▸ by simp [bit1, bit0, add_left_comm, add_assoc]
theorem adc_bit1_bit0 {α} [semiring α] (a b c : α) (h : a + b + 1 = c) :
  bit1 a + bit0 b + 1 = bit0 c :=
h ▸ by simp [bit1, bit0, add_left_comm, add_assoc]
theorem adc_bit0_bit1 {α} [semiring α] (a b c : α) (h : a + b + 1 = c) :
  bit0 a + bit1 b + 1 = bit0 c :=
h ▸ by simp [bit1, bit0, add_left_comm, add_assoc]
theorem adc_bit1_bit1 {α} [semiring α] (a b c : α) (h : a + b + 1 = c) :
  bit1 a + bit1 b + 1 = bit1 c :=
h ▸ by simp [bit1, bit0, add_left_comm, add_assoc]

section
open match_numeral_result

meta mutual def prove_add_nat, prove_adc_nat
with prove_add_nat : instance_cache → expr → expr → expr → tactic (instance_cache × expr)
| c a b r := do
  match match_numeral a, match_numeral b with
  | zero, _ := c.mk_app ``zero_add [b]
  | _, zero := c.mk_app ``add_zero [a]
  | _, one := prove_succ c a r
  | one, _ := do (c, p) ← prove_succ c b r, c.mk_app ``one_add [b, r, p]
  | bit0 a, bit0 b :=
    do let r := r.app_arg, (c, p) ← prove_add_nat c a b r, c.mk_app ``add_bit0_bit0 [a, b, r, p]
  | bit0 a, bit1 b :=
    do let r := r.app_arg, (c, p) ← prove_add_nat c a b r, c.mk_app ``add_bit0_bit1 [a, b, r, p]
  | bit1 a, bit0 b :=
    do let r := r.app_arg, (c, p) ← prove_add_nat c a b r, c.mk_app ``add_bit1_bit0 [a, b, r, p]
  | bit1 a, bit1 b :=
    do let r := r.app_arg, (c, p) ← prove_adc_nat c a b r, c.mk_app ``add_bit1_bit1 [a, b, r, p]
  | _, _ := failed
  end
with prove_adc_nat : instance_cache → expr → expr → expr → tactic (instance_cache × expr)
| c a b r := do
  match match_numeral a, match_numeral b with
  | zero, _ := do (c, p) ← prove_succ c b r, c.mk_app ``zero_adc [b, r, p]
  | _, zero := do (c, p) ← prove_succ c b r, c.mk_app ``adc_zero [b, r, p]
  | one, one := c.mk_app ``adc_one_one []
  | bit0 a, one :=
    do let r := r.app_arg, (c, p) ← prove_succ c a r, c.mk_app ``adc_bit0_one [a, r, p]
  | one, bit0 b :=
    do let r := r.app_arg, (c, p) ← prove_succ c b r, c.mk_app ``adc_one_bit0 [b, r, p]
  | bit1 a, one :=
    do let r := r.app_arg, (c, p) ← prove_succ c a r, c.mk_app ``adc_bit1_one [a, r, p]
  | one, bit1 b :=
    do let r := r.app_arg, (c, p) ← prove_succ c b r, c.mk_app ``adc_one_bit1 [b, r, p]
  | bit0 a, bit0 b :=
    do let r := r.app_arg, (c, p) ← prove_add_nat c a b r, c.mk_app ``adc_bit0_bit0 [a, b, r, p]
  | bit0 a, bit1 b :=
    do let r := r.app_arg, (c, p) ← prove_adc_nat c a b r, c.mk_app ``adc_bit0_bit1 [a, b, r, p]
  | bit1 a, bit0 b :=
    do let r := r.app_arg, (c, p) ← prove_adc_nat c a b r, c.mk_app ``adc_bit1_bit0 [a, b, r, p]
  | bit1 a, bit1 b :=
    do let r := r.app_arg, (c, p) ← prove_adc_nat c a b r, c.mk_app ``adc_bit1_bit1 [a, b, r, p]
  | _, _ := failed
  end

/-- Given `a`,`b`,`r` natural numerals, proves `⊢ a + b = r`. -/
add_decl_doc prove_add_nat
/-- Given `a`,`b`,`r` natural numerals, proves `⊢ a + b + 1 = r`. -/
add_decl_doc prove_adc_nat

/-- Given `a`,`b` natural numerals, returns `(r, ⊢ a + b = r)`. -/
meta def prove_add_nat' (c : instance_cache) (a b : expr) : tactic (instance_cache × expr × expr) :=
do na ← a.to_nat,
  nb ← b.to_nat,
  (c, r) ← c.of_nat (na + nb),
  (c, p) ← prove_add_nat c a b r,
  return (c, r, p)

end

theorem bit0_mul {α} [semiring α] (a b c : α) (h : a * b = c) :
  bit0 a * b = bit0 c := h ▸ by simp [bit0, add_mul]
theorem mul_bit0' {α} [semiring α] (a b c : α) (h : a * b = c) :
  a * bit0 b = bit0 c := h ▸ by simp [bit0, mul_add]
theorem mul_bit0_bit0 {α} [semiring α] (a b c : α) (h : a * b = c) :
  bit0 a * bit0 b = bit0 (bit0 c) := bit0_mul _ _ _ (mul_bit0' _ _ _ h)
theorem mul_bit1_bit1 {α} [semiring α] (a b c d e : α)
  (hc : a * b = c) (hd : a + b = d) (he : bit0 c + d = e) :
  bit1 a * bit1 b = bit1 e :=
by rw [← he, ← hd, ← hc]; simp [bit1, bit0, mul_add, add_mul, add_left_comm, add_assoc]

section
open match_numeral_result

/-- Given `a`,`b` natural numerals, returns `(r, ⊢ a * b = r)`. -/
meta def prove_mul_nat : instance_cache → expr → expr → tactic (instance_cache × expr × expr)
| ic a b :=
  match match_numeral a, match_numeral b with
  | zero, _ := do
    (ic, z) ← ic.mk_app ``has_zero.zero [],
    (ic, p) ← ic.mk_app ``zero_mul [b],
    return (ic, z, p)
  | _, zero := do
    (ic, z) ← ic.mk_app ``has_zero.zero [],
    (ic, p) ← ic.mk_app ``mul_zero [a],
    return (ic, z, p)
  | one, _ := do (ic, p) ← ic.mk_app ``one_mul [b], return (ic, b, p)
  | _, one := do (ic, p) ← ic.mk_app ``mul_one [a], return (ic, a, p)
  | bit0 a, bit0 b := do
    (ic, c, p) ← prove_mul_nat ic a b,
    (ic, p) ← ic.mk_app ``mul_bit0_bit0 [a, b, c, p],
    (ic, c') ← ic.mk_bit0 c,
    (ic, c') ← ic.mk_bit0 c',
    return (ic, c', p)
  | bit0 a, _ := do
    (ic, c, p) ← prove_mul_nat ic a b,
    (ic, p) ← ic.mk_app ``bit0_mul [a, b, c, p],
    (ic, c') ← ic.mk_bit0 c,
    return (ic, c', p)
  | _, bit0 b := do
    (ic, c, p) ← prove_mul_nat ic a b,
    (ic, p) ← ic.mk_app ``mul_bit0' [a, b, c, p],
    (ic, c') ← ic.mk_bit0 c,
    return (ic, c', p)
  | bit1 a, bit1 b := do
    (ic, c, pc) ← prove_mul_nat ic a b,
    (ic, d, pd) ← prove_add_nat' ic a b,
    (ic, c') ← ic.mk_bit0 c,
    (ic, e, pe) ← prove_add_nat' ic c' d,
    (ic, p) ← ic.mk_app ``mul_bit1_bit1 [a, b, c, d, e, pc, pd, pe],
    (ic, e') ← ic.mk_bit1 e,
    return (ic, e', p)
  | _, _ := failed
  end

end

section
open match_numeral_result

/-- Given `a` a positive natural numeral, returns `⊢ 0 < a`. -/
meta def prove_pos_nat (c : instance_cache) : expr → tactic (instance_cache × expr)
| e :=
  match match_numeral e with
  | one := c.mk_app ``zero_lt_one' []
  | bit0 e := do (c, p) ← prove_pos_nat e, c.mk_app ``bit0_pos [e, p]
  | bit1 e := do (c, p) ← prove_pos_nat e, c.mk_app ``bit1_pos' [e, p]
  | _ := failed
  end

end

/-- Given `a` a rational numeral, returns `⊢ 0 < a`. -/
meta def prove_pos (c : instance_cache) : expr → tactic (instance_cache × expr)
| `(%%e₁ / %%e₂) := do
  (c, p₁) ← prove_pos_nat c e₁, (c, p₂) ← prove_pos_nat c e₂,
  c.mk_app ``div_pos [e₁, e₂, p₁, p₂]
| e := prove_pos_nat c e

/-- `match_neg (- e) = some e`, otherwise `none` -/
meta def match_neg : expr → option expr
| `(- %%e) := some e
| _ := none

/-- `match_sign (- e) = inl e`, `match_sign 0 = inr ff`, otherwise `inr tt` -/
meta def match_sign : expr → expr ⊕ bool
| `(- %%e) := sum.inl e
| `(has_zero.zero) := sum.inr ff
| _ := sum.inr tt

theorem ne_zero_of_pos {α} [ordered_add_comm_group α] (a : α) : 0 < a → a ≠ 0 := ne_of_gt
theorem ne_zero_neg {α} [add_group α] (a : α) : a ≠ 0 → -a ≠ 0 := mt neg_eq_zero.1

/-- Given `a` a rational numeral, returns `⊢ a ≠ 0`. -/
meta def prove_ne_zero' (c : instance_cache) : expr → tactic (instance_cache × expr)
| a :=
  match match_neg a with
  | some a := do (c, p) ← prove_ne_zero' a, c.mk_app ``ne_zero_neg [a, p]
  | none := do (c, p) ← prove_pos c a, c.mk_app ``ne_zero_of_pos [a, p]
  end

theorem clear_denom_div {α} [division_ring α] (a b b' c d : α)
  (h₀ : b ≠ 0) (h₁ : b * b' = d) (h₂ : a * b' = c) : (a / b) * d = c :=
by rwa [← h₁, ← mul_assoc, div_mul_cancel _ h₀]

/-- Given `a` nonnegative rational and `d` a natural number, returns `(b, ⊢ a * d = b)`.
(`d` should be a multiple of the denominator of `a`, so that `b` is a natural number.) -/
meta def prove_clear_denom'
  (prove_ne_zero : instance_cache → expr → ℚ → tactic (instance_cache × expr))
  (c : instance_cache) (a d : expr) (na : ℚ) (nd : ℕ) :
  tactic (instance_cache × expr × expr) :=
if na.denom = 1 then
  prove_mul_nat c a d
else do
  [_, _, a, b] ← return a.get_app_args,
  (c, b') ← c.of_nat (nd / na.denom),
  (c, p₀) ← prove_ne_zero c b (rat.of_int na.denom),
  (c, _, p₁) ← prove_mul_nat c b b',
  (c, r, p₂) ← prove_mul_nat c a b',
  (c, p) ← c.mk_app ``clear_denom_div [a, b, b', r, d, p₀, p₁, p₂],
  return (c, r, p)

theorem nonneg_pos {α} [ordered_cancel_add_comm_monoid α] (a : α) : 0 < a → 0 ≤ a := le_of_lt

theorem lt_one_bit0 {α} [linear_ordered_semiring α] (a : α) (h : 1 ≤ a) : 1 < bit0 a :=
lt_of_lt_of_le one_lt_two (bit0_le_bit0.2 h)
theorem lt_one_bit1 {α} [linear_ordered_semiring α] (a : α) (h : 0 < a) : 1 < bit1 a :=
one_lt_bit1.2 h
theorem lt_bit0_bit0 {α} [linear_ordered_semiring α] (a b : α) : a < b → bit0 a < bit0 b :=
bit0_lt_bit0.2
theorem lt_bit0_bit1 {α} [linear_ordered_semiring α] (a b : α) (h : a ≤ b) : bit0 a < bit1 b :=
lt_of_le_of_lt (bit0_le_bit0.2 h) (lt_add_one _)
theorem lt_bit1_bit0 {α} [linear_ordered_semiring α] (a b : α) (h : a + 1 ≤ b) : bit1 a < bit0 b :=
lt_of_lt_of_le (by simp [bit0, bit1, zero_lt_one, add_assoc]) (bit0_le_bit0.2 h)
theorem lt_bit1_bit1 {α} [linear_ordered_semiring α] (a b : α) : a < b → bit1 a < bit1 b :=
bit1_lt_bit1.2

theorem le_one_bit0 {α} [linear_ordered_semiring α] (a : α) (h : 1 ≤ a) : 1 ≤ bit0 a :=
le_of_lt (lt_one_bit0 _ h)
-- deliberately strong hypothesis because bit1 0 is not a numeral
theorem le_one_bit1 {α} [linear_ordered_semiring α] (a : α) (h : 0 < a) : 1 ≤ bit1 a :=
le_of_lt (lt_one_bit1 _ h)
theorem le_bit0_bit0 {α} [linear_ordered_semiring α] (a b : α) : a ≤ b → bit0 a ≤ bit0 b :=
bit0_le_bit0.2
theorem le_bit0_bit1 {α} [linear_ordered_semiring α] (a b : α) (h : a ≤ b) : bit0 a ≤ bit1 b :=
le_of_lt (lt_bit0_bit1 _ _ h)
theorem le_bit1_bit0 {α} [linear_ordered_semiring α] (a b : α) (h : a + 1 ≤ b) : bit1 a ≤ bit0 b :=
le_of_lt (lt_bit1_bit0 _ _ h)
theorem le_bit1_bit1 {α} [linear_ordered_semiring α] (a b : α) : a ≤ b → bit1 a ≤ bit1 b :=
bit1_le_bit1.2

theorem sle_one_bit0 {α} [linear_ordered_semiring α] (a : α) : 1 ≤ a → 1 + 1 ≤ bit0 a :=
bit0_le_bit0.2
theorem sle_one_bit1 {α} [linear_ordered_semiring α] (a : α) : 1 ≤ a → 1 + 1 ≤ bit1 a :=
le_bit0_bit1 _ _
theorem sle_bit0_bit0 {α} [linear_ordered_semiring α] (a b : α) : a + 1 ≤ b → bit0 a + 1 ≤ bit0 b :=
le_bit1_bit0 _ _
theorem sle_bit0_bit1 {α} [linear_ordered_semiring α] (a b : α) (h : a ≤ b) : bit0 a + 1 ≤ bit1 b :=
bit1_le_bit1.2 h
theorem sle_bit1_bit0 {α} [linear_ordered_semiring α] (a b : α) (h : a + 1 ≤ b) :
  bit1 a + 1 ≤ bit0 b :=
(bit1_succ a _ rfl).symm ▸ bit0_le_bit0.2 h
theorem sle_bit1_bit1 {α} [linear_ordered_semiring α] (a b : α) (h : a + 1 ≤ b) :
  bit1 a + 1 ≤ bit1 b :=
(bit1_succ a _ rfl).symm ▸ le_bit0_bit1 _ _ h

/-- Given `a` a rational numeral, returns `⊢ 0 ≤ a`. -/
meta def prove_nonneg (ic : instance_cache) : expr → tactic (instance_cache × expr)
| e@`(has_zero.zero) := ic.mk_app ``le_refl [e]
| e :=
  if ic.α = `(ℕ) then
    return (ic, `(nat.zero_le).mk_app [e])
  else do
    (ic, p) ← prove_pos ic e,
    ic.mk_app ``nonneg_pos [e, p]

section
open match_numeral_result

/-- Given `a` a rational numeral, returns `⊢ 1 ≤ a`. -/
meta def prove_one_le_nat (ic : instance_cache) : expr → tactic (instance_cache × expr)
| a :=
  match match_numeral a with
  | one := ic.mk_app ``le_refl [a]
  | bit0 a := do (ic, p) ← prove_one_le_nat a, ic.mk_app ``le_one_bit0 [a, p]
  | bit1 a := do (ic, p) ← prove_pos_nat ic a, ic.mk_app ``le_one_bit1 [a, p]
  | _ := failed
  end

meta mutual def prove_le_nat, prove_sle_nat (ic : instance_cache)
with prove_le_nat : expr → expr → tactic (instance_cache × expr)
| a b :=
  if a = b then ic.mk_app ``le_refl [a] else
  match match_numeral a, match_numeral b with
  | zero, _ := prove_nonneg ic b
  | one, bit0 b := do (ic, p) ← prove_one_le_nat ic b, ic.mk_app ``le_one_bit0 [b, p]
  | one, bit1 b := do (ic, p) ← prove_pos_nat ic b, ic.mk_app ``le_one_bit1 [b, p]
  | bit0 a, bit0 b := do (ic, p) ← prove_le_nat a b, ic.mk_app ``le_bit0_bit0 [a, b, p]
  | bit0 a, bit1 b := do (ic, p) ← prove_le_nat a b, ic.mk_app ``le_bit0_bit1 [a, b, p]
  | bit1 a, bit0 b := do (ic, p) ← prove_sle_nat a b, ic.mk_app ``le_bit1_bit0 [a, b, p]
  | bit1 a, bit1 b := do (ic, p) ← prove_le_nat a b, ic.mk_app ``le_bit1_bit1 [a, b, p]
  | _, _ := failed
  end
with prove_sle_nat : expr → expr → tactic (instance_cache × expr)
| a b :=
  match match_numeral a, match_numeral b with
  | zero, _ := prove_nonneg ic b
  | one, bit0 b := do (ic, p) ← prove_one_le_nat ic b, ic.mk_app ``sle_one_bit0 [b, p]
  | one, bit1 b := do (ic, p) ← prove_one_le_nat ic b, ic.mk_app ``sle_one_bit1 [b, p]
  | bit0 a, bit0 b := do (ic, p) ← prove_sle_nat a b, ic.mk_app ``sle_bit0_bit0 [a, b, p]
  | bit0 a, bit1 b := do (ic, p) ← prove_le_nat a b, ic.mk_app ``sle_bit0_bit1 [a, b, p]
  | bit1 a, bit0 b := do (ic, p) ← prove_sle_nat a b, ic.mk_app ``sle_bit1_bit0 [a, b, p]
  | bit1 a, bit1 b := do (ic, p) ← prove_sle_nat a b, ic.mk_app ``sle_bit1_bit1 [a, b, p]
  | _, _ := failed
  end

/-- Given `a`,`b` natural numerals, proves `⊢ a ≤ b`. -/
add_decl_doc prove_le_nat
/-- Given `a`,`b` natural numerals, proves `⊢ a + 1 ≤ b`. -/
add_decl_doc prove_sle_nat

/-- Given `a`,`b` natural numerals, proves `⊢ a < b`. -/
meta def prove_lt_nat (ic : instance_cache) : expr → expr → tactic (instance_cache × expr)
| a b :=
  match match_numeral a, match_numeral b with
  | zero, _ := prove_pos ic b
  | one, bit0 b := do (ic, p) ← prove_one_le_nat ic b, ic.mk_app ``lt_one_bit0 [b, p]
  | one, bit1 b := do (ic, p) ← prove_pos_nat ic b, ic.mk_app ``lt_one_bit1 [b, p]
  | bit0 a, bit0 b := do (ic, p) ← prove_lt_nat a b, ic.mk_app ``lt_bit0_bit0 [a, b, p]
  | bit0 a, bit1 b := do (ic, p) ← prove_le_nat ic a b, ic.mk_app ``lt_bit0_bit1 [a, b, p]
  | bit1 a, bit0 b := do (ic, p) ← prove_sle_nat ic a b, ic.mk_app ``lt_bit1_bit0 [a, b, p]
  | bit1 a, bit1 b := do (ic, p) ← prove_lt_nat a b, ic.mk_app ``lt_bit1_bit1 [a, b, p]
  | _, _ := failed
  end

end

theorem clear_denom_lt {α} [linear_ordered_semiring α] (a a' b b' d : α)
  (h₀ : 0 < d) (ha : a * d = a') (hb : b * d = b') (h : a' < b') : a < b :=
lt_of_mul_lt_mul_right (by rwa [ha, hb]) (le_of_lt h₀)

/-- Given `a`,`b` nonnegative rational numerals, proves `⊢ a < b`. -/
meta def prove_lt_nonneg_rat (ic : instance_cache) (a b : expr) (na nb : ℚ) :
  tactic (instance_cache × expr) :=
if na.denom = 1 ∧ nb.denom = 1 then
  prove_lt_nat ic a b
else do
  let nd := na.denom.lcm nb.denom,
  (ic, d) ← ic.of_nat nd,
  (ic, p₀) ← prove_pos ic d,
  (ic, a', pa) ← prove_clear_denom' (λ ic e _, prove_ne_zero' ic e) ic a d na nd,
  (ic, b', pb) ← prove_clear_denom' (λ ic e _, prove_ne_zero' ic e) ic b d nb nd,
  (ic, p) ← prove_lt_nat ic a' b',
  ic.mk_app ``clear_denom_lt [a, a', b, b', d, p₀, pa, pb, p]

lemma lt_neg_pos {α} [ordered_add_comm_group α] (a b : α) (ha : 0 < a) (hb : 0 < b) : -a < b :=
lt_trans (neg_neg_of_pos ha) hb

/-- Given `a`,`b` rational numerals, proves `⊢ a < b`. -/
meta def prove_lt_rat (ic : instance_cache) (a b : expr) (na nb : ℚ) :
  tactic (instance_cache × expr) :=
match match_sign a, match_sign b with
| sum.inl a, sum.inl b := do
  -- we have to switch the order of `a` and `b` because `a < b ↔ -b < -a`
  (ic, p) ← prove_lt_nonneg_rat ic b a (-nb) (-na),
  ic.mk_app ``neg_lt_neg [b, a, p]
| sum.inl a, sum.inr ff := do
  (ic, p) ← prove_pos ic a,
  ic.mk_app ``neg_neg_of_pos [a, p]
| sum.inl a, sum.inr tt := do
  (ic, pa) ← prove_pos ic a,
  (ic, pb) ← prove_pos ic b,
  ic.mk_app ``lt_neg_pos [a, b, pa, pb]
| sum.inr ff, _ := prove_pos ic b
| sum.inr tt, _ := prove_lt_nonneg_rat ic a b na nb
end

theorem clear_denom_le {α} [linear_ordered_semiring α] (a a' b b' d : α)
  (h₀ : 0 < d) (ha : a * d = a') (hb : b * d = b') (h : a' ≤ b') : a ≤ b :=
le_of_mul_le_mul_right (by rwa [ha, hb]) h₀

/-- Given `a`,`b` nonnegative rational numerals, proves `⊢ a ≤ b`. -/
meta def prove_le_nonneg_rat (ic : instance_cache) (a b : expr) (na nb : ℚ) :
  tactic (instance_cache × expr) :=
if na.denom = 1 ∧ nb.denom = 1 then
  prove_le_nat ic a b
else do
  let nd := na.denom.lcm nb.denom,
  (ic, d) ← ic.of_nat nd,
  (ic, p₀) ← prove_pos ic d,
  (ic, a', pa) ← prove_clear_denom' (λ ic e _, prove_ne_zero' ic e) ic a d na nd,
  (ic, b', pb) ← prove_clear_denom' (λ ic e _, prove_ne_zero' ic e) ic b d nb nd,
  (ic, p) ← prove_le_nat ic a' b',
  ic.mk_app ``clear_denom_le [a, a', b, b', d, p₀, pa, pb, p]

lemma le_neg_pos {α} [ordered_add_comm_group α] (a b : α) (ha : 0 ≤ a) (hb : 0 ≤ b) : -a ≤ b :=
le_trans (neg_nonpos_of_nonneg ha) hb

/-- Given `a`,`b` rational numerals, proves `⊢ a ≤ b`. -/
meta def prove_le_rat (ic : instance_cache) (a b : expr) (na nb : ℚ) :
  tactic (instance_cache × expr) :=
match match_sign a, match_sign b with
| sum.inl a, sum.inl b := do
  (ic, p) ← prove_le_nonneg_rat ic a b (-na) (-nb),
  ic.mk_app ``neg_le_neg [a, b, p]
| sum.inl a, sum.inr ff := do
  (ic, p) ← prove_nonneg ic a,
  ic.mk_app ``neg_nonpos_of_nonneg [a, p]
| sum.inl a, sum.inr tt := do
  (ic, pa) ← prove_nonneg ic a,
  (ic, pb) ← prove_nonneg ic b,
  ic.mk_app ``le_neg_pos [a, b, pa, pb]
| sum.inr ff, _ := prove_nonneg ic b
| sum.inr tt, _ := prove_le_nonneg_rat ic a b na nb
end

/-- Given `a`,`b` rational numerals, proves `⊢ a ≠ b`. This version tries to prove
`⊢ a < b` or `⊢ b < a`, and so is not appropriate for types without an order relation. -/
meta def prove_ne_rat (ic : instance_cache) (a b : expr) (na nb : ℚ) :
  tactic (instance_cache × expr) :=
if na < nb then do
  (ic, p) ← prove_lt_rat ic a b na nb,
  ic.mk_app ``ne_of_lt [a, b, p]
else do
  (ic, p) ← prove_lt_rat ic b a nb na,
  ic.mk_app ``ne_of_gt [a, b, p]

theorem nat_cast_zero {α} [semiring α] : ↑(0 : ℕ) = (0 : α) := nat.cast_zero
theorem nat_cast_one {α} [semiring α] : ↑(1 : ℕ) = (1 : α) := nat.cast_one
theorem nat_cast_bit0 {α} [semiring α] (a : ℕ) (a' : α) (h : ↑a = a') : ↑(bit0 a) = bit0 a' :=
h ▸ nat.cast_bit0 _
theorem nat_cast_bit1 {α} [semiring α] (a : ℕ) (a' : α) (h : ↑a = a') : ↑(bit1 a) = bit1 a' :=
h ▸ nat.cast_bit1 _
theorem int_cast_zero {α} [ring α] : ↑(0 : ℤ) = (0 : α) := int.cast_zero
theorem int_cast_one {α} [ring α] : ↑(1 : ℤ) = (1 : α) := int.cast_one
theorem int_cast_bit0 {α} [ring α] (a : ℤ) (a' : α) (h : ↑a = a') : ↑(bit0 a) = bit0 a' :=
h ▸ int.cast_bit0 _
theorem int_cast_bit1 {α} [ring α] (a : ℤ) (a' : α) (h : ↑a = a') : ↑(bit1 a) = bit1 a' :=
h ▸ int.cast_bit1 _
theorem rat_cast_bit0 {α} [division_ring α] [char_zero α] (a : ℚ) (a' : α) (h : ↑a = a') :
  ↑(bit0 a) = bit0 a' :=
h ▸ rat.cast_bit0 _
theorem rat_cast_bit1 {α} [division_ring α] [char_zero α] (a : ℚ) (a' : α) (h : ↑a = a') :
  ↑(bit1 a) = bit1 a' :=
h ▸ rat.cast_bit1 _

/-- Given `a' : α` a natural numeral, returns `(a : ℕ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
meta def prove_nat_uncast (ic nc : instance_cache) : ∀ (a' : expr),
  tactic (instance_cache × instance_cache × expr × expr)
| a' :=
  match match_numeral a' with
  | match_numeral_result.zero := do
    (nc, e) ← nc.mk_app ``has_zero.zero [],
    (ic, p) ← ic.mk_app ``nat_cast_zero [],
    return (ic, nc, e, p)
  | match_numeral_result.one := do
    (nc, e) ← nc.mk_app ``has_one.one [],
    (ic, p) ← ic.mk_app ``nat_cast_one [],
    return (ic, nc, e, p)
  | match_numeral_result.bit0 a' := do
    (ic, nc, a, p) ← prove_nat_uncast a',
    (nc, a0) ← nc.mk_bit0 a,
    (ic, p) ← ic.mk_app ``nat_cast_bit0 [a, a', p],
    return (ic, nc, a0, p)
  | match_numeral_result.bit1 a' := do
    (ic, nc, a, p) ← prove_nat_uncast a',
    (nc, a1) ← nc.mk_bit1 a,
    (ic, p) ← ic.mk_app ``nat_cast_bit1 [a, a', p],
    return (ic, nc, a1, p)
  | _ := failed
  end

/-- Given `a' : α` a natural numeral, returns `(a : ℤ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
meta def prove_int_uncast_nat (ic zc : instance_cache) : ∀ (a' : expr),
  tactic (instance_cache × instance_cache × expr × expr)
| a' :=
  match match_numeral a' with
  | match_numeral_result.zero := do
    (zc, e) ← zc.mk_app ``has_zero.zero [],
    (ic, p) ← ic.mk_app ``int_cast_zero [],
    return (ic, zc, e, p)
  | match_numeral_result.one := do
    (zc, e) ← zc.mk_app ``has_one.one [],
    (ic, p) ← ic.mk_app ``int_cast_one [],
    return (ic, zc, e, p)
  | match_numeral_result.bit0 a' := do
    (ic, zc, a, p) ← prove_int_uncast_nat a',
    (zc, a0) ← zc.mk_bit0 a,
    (ic, p) ← ic.mk_app ``int_cast_bit0 [a, a', p],
    return (ic, zc, a0, p)
  | match_numeral_result.bit1 a' := do
    (ic, zc, a, p) ← prove_int_uncast_nat a',
    (zc, a1) ← zc.mk_bit1 a,
    (ic, p) ← ic.mk_app ``int_cast_bit1 [a, a', p],
    return (ic, zc, a1, p)
  | _ := failed
  end

/-- Given `a' : α` a natural numeral, returns `(a : ℚ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
meta def prove_rat_uncast_nat (ic qc : instance_cache) (cz_inst : expr) : ∀ (a' : expr),
  tactic (instance_cache × instance_cache × expr × expr)
| a' :=
  match match_numeral a' with
  | match_numeral_result.zero := do
    (qc, e) ← qc.mk_app ``has_zero.zero [],
    (ic, p) ← ic.mk_app ``rat.cast_zero [],
    return (ic, qc, e, p)
  | match_numeral_result.one := do
    (qc, e) ← qc.mk_app ``has_one.one [],
    (ic, p) ← ic.mk_app ``rat.cast_one [],
    return (ic, qc, e, p)
  | match_numeral_result.bit0 a' := do
    (ic, qc, a, p) ← prove_rat_uncast_nat a',
    (qc, a0) ← qc.mk_bit0 a,
    (ic, p) ← ic.mk_app ``rat_cast_bit0 [cz_inst, a, a', p],
    return (ic, qc, a0, p)
  | match_numeral_result.bit1 a' := do
    (ic, qc, a, p) ← prove_rat_uncast_nat a',
    (qc, a1) ← qc.mk_bit1 a,
    (ic, p) ← ic.mk_app ``rat_cast_bit1 [cz_inst, a, a', p],
    return (ic, qc, a1, p)
  | _ := failed
  end

theorem rat_cast_div {α} [division_ring α] [char_zero α] (a b : ℚ) (a' b' : α)
  (ha : ↑a = a') (hb : ↑b = b') : ↑(a / b) = a' / b' :=
ha ▸ hb ▸ rat.cast_div _ _

/-- Given `a' : α` a nonnegative rational numeral, returns `(a : ℚ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
meta def prove_rat_uncast_nonneg (ic qc : instance_cache) (cz_inst a' : expr) (na' : ℚ) :
 tactic (instance_cache × instance_cache × expr × expr) :=
if na'.denom = 1 then
  prove_rat_uncast_nat ic qc cz_inst a'
else do
  [_, _, a', b'] ← return a'.get_app_args,
  (ic, qc, a, pa) ← prove_rat_uncast_nat ic qc cz_inst a',
  (ic, qc, b, pb) ← prove_rat_uncast_nat ic qc cz_inst b',
  (qc, e) ← qc.mk_app ``has_div.div [a, b],
  (ic, p) ← ic.mk_app ``rat_cast_div [cz_inst, a, b, a', b', pa, pb],
  return (ic, qc, e, p)

theorem int_cast_neg {α} [ring α] (a : ℤ) (a' : α) (h : ↑a = a') : ↑-a = -a' :=
h ▸ int.cast_neg _
theorem rat_cast_neg {α} [division_ring α] (a : ℚ) (a' : α) (h : ↑a = a') : ↑-a = -a' :=
h ▸ rat.cast_neg _

/-- Given `a' : α` an integer numeral, returns `(a : ℤ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
meta def prove_int_uncast (ic zc : instance_cache) (a' : expr) :
  tactic (instance_cache × instance_cache × expr × expr) :=
match match_neg a' with
| some a' := do
  (ic, zc, a, p) ← prove_int_uncast_nat ic zc a',
  (zc, e) ← zc.mk_app ``has_neg.neg [a],
  (ic, p) ← ic.mk_app ``int_cast_neg [a, a', p],
  return (ic, zc, e, p)
| none := prove_int_uncast_nat ic zc a'
end

/-- Given `a' : α` a rational numeral, returns `(a : ℚ, ⊢ ↑a = a')`.
(Note that the returned value is on the left of the equality.) -/
meta def prove_rat_uncast (ic qc : instance_cache) (cz_inst a' : expr) (na' : ℚ) :
  tactic (instance_cache × instance_cache × expr × expr) :=
match match_neg a' with
| some a' := do
  (ic, qc, a, p) ← prove_rat_uncast_nonneg ic qc cz_inst a' (-na'),
  (qc, e) ← qc.mk_app ``has_neg.neg [a],
  (ic, p) ← ic.mk_app ``rat_cast_neg [a, a', p],
  return (ic, qc, e, p)
| none := prove_rat_uncast_nonneg ic qc cz_inst a' na'
end

theorem nat_cast_ne {α} [semiring α] [char_zero α] (a b : ℕ) (a' b' : α)
  (ha : ↑a = a') (hb : ↑b = b') (h : a ≠ b) : a' ≠ b' :=
ha ▸ hb ▸ mt nat.cast_inj.1 h
theorem int_cast_ne {α} [ring α] [char_zero α] (a b : ℤ) (a' b' : α)
  (ha : ↑a = a') (hb : ↑b = b') (h : a ≠ b) : a' ≠ b' :=
ha ▸ hb ▸ mt int.cast_inj.1 h
theorem rat_cast_ne {α} [division_ring α] [char_zero α] (a b : ℚ) (a' b' : α)
  (ha : ↑a = a') (hb : ↑b = b') (h : a ≠ b) : a' ≠ b' :=
ha ▸ hb ▸ mt rat.cast_inj.1 h

/-- Given `a`,`b` rational numerals, proves `⊢ a ≠ b`. Currently it tries two methods:

  * Prove `⊢ a < b` or `⊢ b < a`, if the base type has an order
  * Embed `↑(a':ℚ) = a` and `↑(b':ℚ) = b`, and then prove `a' ≠ b'`.
    This requires that the base type be `char_zero`, and also that it be a `division_ring`
    so that the coercion from `ℚ` is well defined.

We may also add coercions to `ℤ` and `ℕ` as well in order to support `char_zero`
rings and semirings. -/
meta def prove_ne : instance_cache → expr → expr → ℚ → ℚ → tactic (instance_cache × expr)
| ic a b na nb := prove_ne_rat ic a b na nb <|> do
  cz_inst ← mk_mapp ``char_zero [ic.α, none, none] >>= mk_instance,
  if na.denom = 1 ∧ nb.denom = 1 then
    if na ≥ 0 ∧ nb ≥ 0 then do
      guard (ic.α ≠ `(ℕ)),
      nc ← mk_instance_cache `(ℕ),
      (ic, nc, a', pa) ← prove_nat_uncast ic nc a,
      (ic, nc, b', pb) ← prove_nat_uncast ic nc b,
      (nc, p) ← prove_ne_rat nc a' b' na nb,
      ic.mk_app ``nat_cast_ne [cz_inst, a', b', a, b, pa, pb, p]
    else do
      guard (ic.α ≠ `(ℤ)),
      zc ← mk_instance_cache `(ℤ),
      (ic, zc, a', pa) ← prove_int_uncast ic zc a,
      (ic, zc, b', pb) ← prove_int_uncast ic zc b,
      (zc, p) ← prove_ne_rat zc a' b' na nb,
      ic.mk_app ``int_cast_ne [cz_inst, a', b', a, b, pa, pb, p]
  else do
    guard (ic.α ≠ `(ℚ)),
    qc ← mk_instance_cache `(ℚ),
    (ic, qc, a', pa) ← prove_rat_uncast ic qc cz_inst a na,
    (ic, qc, b', pb) ← prove_rat_uncast ic qc cz_inst b nb,
    (qc, p) ← prove_ne_rat qc a' b' na nb,
    ic.mk_app ``rat_cast_ne [cz_inst, a', b', a, b, pa, pb, p]

/-- Given `a` a rational numeral, returns `⊢ a ≠ 0`. -/
meta def prove_ne_zero (ic : instance_cache) : expr → ℚ → tactic (instance_cache × expr)
| a na := do
  (ic, z) ← ic.mk_app ``has_zero.zero [],
  prove_ne ic a z na 0

/-- Given `a` nonnegative rational and `d` a natural number, returns `(b, ⊢ a * d = b)`.
(`d` should be a multiple of the denominator of `a`, so that `b` is a natural number.) -/
meta def prove_clear_denom : instance_cache → expr → expr → ℚ → ℕ →
  tactic (instance_cache × expr × expr) := prove_clear_denom' prove_ne_zero

theorem clear_denom_add {α} [division_ring α] (a a' b b' c c' d : α)
  (h₀ : d ≠ 0) (ha : a * d = a') (hb : b * d = b') (hc : c * d = c')
  (h : a' + b' = c') : a + b = c :=
mul_right_cancel' h₀ $ by rwa [add_mul, ha, hb, hc]

/-- Given `a`,`b`,`c` nonnegative rational numerals, returns `⊢ a + b = c`. -/
meta def prove_add_nonneg_rat (ic : instance_cache) (a b c : expr) (na nb nc : ℚ) :
  tactic (instance_cache × expr) :=
if na.denom = 1 ∧ nb.denom = 1 then
  prove_add_nat ic a b c
else do
  let nd := na.denom.lcm nb.denom,
  (ic, d) ← ic.of_nat nd,
  (ic, p₀) ← prove_ne_zero ic d (rat.of_int nd),
  (ic, a', pa) ← prove_clear_denom ic a d na nd,
  (ic, b', pb) ← prove_clear_denom ic b d nb nd,
  (ic, c', pc) ← prove_clear_denom ic c d nc nd,
  (ic, p) ← prove_add_nat ic a' b' c',
  ic.mk_app ``clear_denom_add [a, a', b, b', c, c', d, p₀, pa, pb, pc, p]

theorem add_pos_neg_pos {α} [add_group α] (a b c : α) (h : c + b = a) : a + -b = c :=
h ▸ by simp
theorem add_pos_neg_neg {α} [add_group α] (a b c : α) (h : c + a = b) : a + -b = -c :=
h ▸ by simp
theorem add_neg_pos_pos {α} [add_group α] (a b c : α) (h : a + c = b) : -a + b = c :=
h ▸ by simp
theorem add_neg_pos_neg {α} [add_group α] (a b c : α) (h : b + c = a) : -a + b = -c :=
h ▸ by simp
theorem add_neg_neg {α} [add_group α] (a b c : α) (h : b + a = c) : -a + -b = -c :=
h ▸ by simp

/-- Given `a`,`b`,`c` rational numerals, returns `⊢ a + b = c`. -/
meta def prove_add_rat (ic : instance_cache) (ea eb ec : expr) (a b c : ℚ) :
  tactic (instance_cache × expr) :=
match match_neg ea, match_neg eb, match_neg ec with
| some ea, some eb, some ec := do
  (ic, p) ← prove_add_nonneg_rat ic eb ea ec (-b) (-a) (-c),
  ic.mk_app ``add_neg_neg [ea, eb, ec, p]
| some ea, none, some ec := do
  (ic, p) ← prove_add_nonneg_rat ic eb ec ea b (-c) (-a),
  ic.mk_app ``add_neg_pos_neg [ea, eb, ec, p]
| some ea, none, none := do
  (ic, p) ← prove_add_nonneg_rat ic ea ec eb (-a) c b,
  ic.mk_app ``add_neg_pos_pos [ea, eb, ec, p]
| none, some eb, some ec := do
  (ic, p) ← prove_add_nonneg_rat ic ec ea eb (-c) a (-b),
  ic.mk_app ``add_pos_neg_neg [ea, eb, ec, p]
| none, some eb, none := do
  (ic, p) ← prove_add_nonneg_rat ic ec eb ea c (-b) a,
  ic.mk_app ``add_pos_neg_pos [ea, eb, ec, p]
| _, _, _ := prove_add_nonneg_rat ic ea eb ec a b c
end

/-- Given `a`,`b` rational numerals, returns `(c, ⊢ a + b = c)`. -/
meta def prove_add_rat' (ic : instance_cache) (a b : expr) :
  tactic (instance_cache × expr × expr) :=
do na ← a.to_rat,
  nb ← b.to_rat,
  let nc := na + nb,
  (ic, c) ← ic.of_rat nc,
  (ic, p) ← prove_add_rat ic a b c na nb nc,
  return (ic, c, p)

theorem clear_denom_simple_nat {α} [division_ring α] (a : α) :
  (1:α) ≠ 0 ∧ a * 1 = a := ⟨one_ne_zero, mul_one _⟩
theorem clear_denom_simple_div {α} [division_ring α] (a b : α) (h : b ≠ 0) :
  b ≠ 0 ∧ a / b * b = a := ⟨h, div_mul_cancel _ h⟩

/-- Given `a` a nonnegative rational numeral, returns `(b, c, ⊢ a * b = c)`
where `b` and `c` are natural numerals. (`b` will be the denominator of `a`.) -/
meta def prove_clear_denom_simple (c : instance_cache) (a : expr) (na : ℚ) :
  tactic (instance_cache × expr × expr × expr) :=
if na.denom = 1 then do
  (c, d) ← c.mk_app ``has_one.one [],
  (c, p) ← c.mk_app ``clear_denom_simple_nat [a],
  return (c, d, a, p)
else do
  [α, _, a, b] ← return a.get_app_args,
  (c, p₀) ← prove_ne_zero c b (rat.of_int na.denom),
  (c, p) ← c.mk_app ``clear_denom_simple_div [a, b, p₀],
  return (c, b, a, p)

theorem clear_denom_mul {α} [field α] (a a' b b' c c' d₁ d₂ d : α)
  (ha : d₁ ≠ 0 ∧ a * d₁ = a') (hb : d₂ ≠ 0 ∧ b * d₂ = b')
  (hc : c * d = c') (hd : d₁ * d₂ = d)
  (h : a' * b' = c') : a * b = c :=
mul_right_cancel' ha.1 $ mul_right_cancel' hb.1 $
by rw [mul_assoc c, hd, hc, ← h, ← ha.2, ← hb.2, ← mul_assoc, mul_right_comm a]

/-- Given `a`,`b` nonnegative rational numerals, returns `(c, ⊢ a * b = c)`. -/
meta def prove_mul_nonneg_rat (ic : instance_cache) (a b : expr) (na nb : ℚ) :
  tactic (instance_cache × expr × expr) :=
if na.denom = 1 ∧ nb.denom = 1 then
  prove_mul_nat ic a b
else do
  let nc := na * nb, (ic, c) ← ic.of_rat nc,
  (ic, d₁, a', pa) ← prove_clear_denom_simple ic a na,
  (ic, d₂, b', pb) ← prove_clear_denom_simple ic b nb,
  (ic, d, pd) ← prove_mul_nat ic d₁ d₂, nd ← d.to_nat,
  (ic, c', pc) ← prove_clear_denom ic c d nc nd,
  (ic, _, p) ← prove_mul_nat ic a' b',
  (ic, p) ← ic.mk_app ``clear_denom_mul [a, a', b, b', c, c', d₁, d₂, d, pa, pb, pc, pd, p],
  return (ic, c, p)

theorem mul_neg_pos {α} [ring α] (a b c : α) (h : a * b = c) : -a * b = -c := h ▸ by simp
theorem mul_pos_neg {α} [ring α] (a b c : α) (h : a * b = c) : a * -b = -c := h ▸ by simp
theorem mul_neg_neg {α} [ring α] (a b c : α) (h : a * b = c) : -a * -b = c := h ▸ by simp

/-- Given `a`,`b` rational numerals, returns `(c, ⊢ a * b = c)`. -/
meta def prove_mul_rat (ic : instance_cache) (a b : expr) (na nb : ℚ) :
  tactic (instance_cache × expr × expr) :=
match match_sign a, match_sign b with
| sum.inl a, sum.inl b := do
  (ic, c, p) ← prove_mul_nonneg_rat ic a b (-na) (-nb),
  (ic, p) ← ic.mk_app ``mul_neg_neg [a, b, c, p],
  return (ic, c, p)
| sum.inr ff, _ := do
  (ic, z) ← ic.mk_app ``has_zero.zero [],
  (ic, p) ← ic.mk_app ``zero_mul [b],
  return (ic, z, p)
| _, sum.inr ff := do
  (ic, z) ← ic.mk_app ``has_zero.zero [],
  (ic, p) ← ic.mk_app ``mul_zero [a],
  return (ic, z, p)
| sum.inl a, sum.inr tt := do
  (ic, c, p) ← prove_mul_nonneg_rat ic a b (-na) nb,
  (ic, p) ← ic.mk_app ``mul_neg_pos [a, b, c, p],
  (ic, c') ← ic.mk_app ``has_neg.neg [c],
  return (ic, c', p)
| sum.inr tt, sum.inl b := do
  (ic, c, p) ← prove_mul_nonneg_rat ic a b na (-nb),
  (ic, p) ← ic.mk_app ``mul_pos_neg [a, b, c, p],
  (ic, c') ← ic.mk_app ``has_neg.neg [c],
  return (ic, c', p)
| sum.inr tt, sum.inr tt := prove_mul_nonneg_rat ic a b na nb
end

theorem inv_neg {α} [division_ring α] (a b : α) (h : a⁻¹ = b) : (-a)⁻¹ = -b :=
h ▸ by simp only [inv_eq_one_div, one_div_neg_eq_neg_one_div]

/-- Given `a` a rational numeral, returns `(b, ⊢ a⁻¹ = b)`. -/
meta def prove_inv : instance_cache → expr → ℚ → tactic (instance_cache × expr × expr)
| ic e n :=
  match match_sign e with
  | sum.inl e := do
    (ic, e', p) ← prove_inv ic e (-n),
    (ic, r) ← ic.mk_app ``has_neg.neg [e'],
    (ic, p) ← ic.mk_app ``inv_neg [e, e', p],
    return (ic, r, p)
  | sum.inr ff := do
    (ic, p) ← ic.mk_app ``inv_zero [],
    return (ic, e, p)
  | sum.inr tt :=
    if n.num = 1 then
      if n.denom = 1 then do
        (ic, p) ← ic.mk_app ``inv_one [],
        return (ic, e, p)
      else do
        let e := e.app_arg,
        (ic, p) ← ic.mk_app ``inv_one_div [e],
        return (ic, e, p)
    else if n.denom = 1 then do
      (ic, p) ← ic.mk_app ``inv_div_one [e],
      e ← infer_type p,
      return (ic, e.app_arg, p)
    else do
      [_, _, a, b] ← return e.get_app_args,
      (ic, e') ← ic.mk_app ``has_div.div [b, a],
      (ic, p) ← ic.mk_app ``inv_div [a, b],
      return (ic, e', p)
  end

theorem div_eq {α} [division_ring α] (a b b' c : α)
  (hb : b⁻¹ = b') (h : a * b' = c) : a / b = c :=
by rwa [ ← hb, ← div_eq_mul_inv] at h

/-- Given `a`,`b` rational numerals, returns `(c, ⊢ a / b = c)`. -/
meta def prove_div (ic : instance_cache) (a b : expr) (na nb : ℚ) :
  tactic (instance_cache × expr × expr) :=
do (ic, b', pb) ← prove_inv ic b nb,
  (ic, c, p) ← prove_mul_rat ic a b' na nb⁻¹,
  (ic, p) ← ic.mk_app ``div_eq [a, b, b', c, pb, p],
  return (ic, c, p)

/-- Given `a` a rational numeral, returns `(b, ⊢ -a = b)`. -/
meta def prove_neg (ic : instance_cache) (a : expr) : tactic (instance_cache × expr × expr) :=
match match_sign a with
| sum.inl a := do
  (ic, p) ← ic.mk_app ``neg_neg [a],
  return (ic, a, p)
| sum.inr ff := do
  (ic, p) ← ic.mk_app ``neg_zero [],
  return (ic, a, p)
| sum.inr tt := do
  (ic, a') ← ic.mk_app ``has_neg.neg [a],
  p ← mk_eq_refl a',
  return (ic, a', p)
end

theorem sub_pos {α} [add_group α] (a b b' c : α) (hb : -b = b') (h : a + b' = c) : a - b = c :=
by rwa [← hb, ← sub_eq_add_neg] at h

theorem sub_neg {α} [add_group α] (a b c : α) (h : a + b = c) : a - -b = c :=
by rwa sub_neg_eq_add

/-- Given `a`,`b` rational numerals, returns `(c, ⊢ a - b = c)`. -/
meta def prove_sub (ic : instance_cache) (a b : expr) : tactic (instance_cache × expr × expr) :=
match match_sign b with
| sum.inl b := do
  (ic, c, p) ← prove_add_rat' ic a b,
  (ic, p) ← ic.mk_app ``sub_neg [a, b, c, p],
  return (ic, c, p)
| sum.inr ff := do
  (ic, p) ← ic.mk_app ``sub_zero [a],
  return (ic, a, p)
| sum.inr tt := do
  (ic, b', pb) ← prove_neg ic b,
  (ic, c, p) ← prove_add_rat' ic a b',
  (ic, p) ← ic.mk_app ``sub_pos [a, b, b', c, pb, p],
  return (ic, c, p)
end

theorem sub_nat_pos (a b c : ℕ) (h : b + c = a) : a - b = c :=
h ▸ nat.add_sub_cancel_left _ _
theorem sub_nat_neg (a b c : ℕ) (h : a + c = b) : a - b = 0 :=
nat.sub_eq_zero_of_le $ h ▸ nat.le_add_right _ _

/-- Given `a : nat`,`b : nat` natural numerals, returns `(c, ⊢ a - b = c)`. -/
meta def prove_sub_nat (ic : instance_cache) (a b : expr) : tactic (expr × expr) :=
do na ← a.to_nat, nb ← b.to_nat,
  if nb ≤ na then do
    (ic, c) ← ic.of_nat (na - nb),
    (ic, p) ← prove_add_nat ic b c a,
    return (c, `(sub_nat_pos).mk_app [a, b, c, p])
  else do
    (ic, c) ← ic.of_nat (nb - na),
    (ic, p) ← prove_add_nat ic a c b,
    return (`(0 : ℕ), `(sub_nat_neg).mk_app [a, b, c, p])

/-- Evaluates the basic field operations `+`,`neg`,`-`,`*`,`inv`,`/` on numerals.
Also handles nat subtraction. Does not do recursive simplification; that is,
`1 + 1 + 1` will not simplify but `2 + 1` will. This is handled by the top level
`simp` call in `norm_num.derive`. -/
meta def eval_field : expr → tactic (expr × expr)
| `(%%e₁ + %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  let n₃ := n₁ + n₂,
  (c, e₃) ← c.of_rat n₃,
  (_, p) ← prove_add_rat c e₁ e₂ e₃ n₁ n₂ n₃,
  return (e₃, p)
| `(%%e₁ * %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  prod.snd <$> prove_mul_rat c e₁ e₂ n₁ n₂
| `(- %%e) := do
  c ← infer_type e >>= mk_instance_cache,
  prod.snd <$> prove_neg c e
| `(@has_sub.sub %%α %%inst %%a %%b) := do
  c ← mk_instance_cache α,
  if α = `(nat) then prove_sub_nat c a b
  else prod.snd <$> prove_sub c a b
| `(has_inv.inv %%e) := do
  n ← e.to_rat,
  c ← infer_type e >>= mk_instance_cache,
  prod.snd <$> prove_inv c e n
| `(%%e₁ / %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  prod.snd <$> prove_div c e₁ e₂ n₁ n₂
| _ := failed

lemma pow_bit0 [monoid α] (a c' c : α) (b : ℕ)
  (h : a ^ b = c') (h₂ : c' * c' = c) : a ^ bit0 b = c :=
h₂ ▸ by simp [pow_bit0, h]

lemma pow_bit1 [monoid α] (a c₁ c₂ c : α) (b : ℕ)
  (h : a ^ b = c₁) (h₂ : c₁ * c₁ = c₂) (h₃ : c₂ * a = c) : a ^ bit1 b = c :=
by rw [← h₃, ← h₂]; simp [pow_bit1, h]

section
open match_numeral_result

/-- Given `a` a rational numeral and `b : nat`, returns `(c, ⊢ a ^ b = c)`. -/
meta def prove_pow (a : expr) (na : ℚ) :
  instance_cache → expr → tactic (instance_cache × expr × expr)
| ic b :=
  match match_numeral b with
  | zero := do
    (ic, p) ← ic.mk_app ``pow_zero [a],
    (ic, o) ← ic.mk_app ``has_one.one [],
    return (ic, o, p)
  | one := do
    (ic, p) ← ic.mk_app ``pow_one [a],
    return (ic, a, p)
  | bit0 b := do
    (ic, c', p) ← prove_pow ic b,
    nc' ← expr.to_rat c',
    (ic, c, p₂) ← prove_mul_rat ic c' c' nc' nc',
    (ic, p) ← ic.mk_app ``pow_bit0 [a, c', c, b, p, p₂],
    return (ic, c, p)
  | bit1 b := do
    (ic, c₁, p) ← prove_pow ic b,
    nc₁ ← expr.to_rat c₁,
    (ic, c₂, p₂) ← prove_mul_rat ic c₁ c₁ nc₁ nc₁,
    (ic, c, p₃) ← prove_mul_rat ic c₂ a (nc₁ * nc₁) na,
    (ic, p) ← ic.mk_app ``pow_bit1 [a, c₁, c₂, c, b, p, p₂, p₃],
    return (ic, c, p)
  | _ := failed
  end

end

/-- Evaluates expressions of the form `a ^ b`, `monoid.npow a b` or `nat.pow a b`. -/
meta def eval_pow : expr → tactic (expr × expr)
| `(@has_pow.pow %%α _ %%m %%e₁ %%e₂) := do
  n₁ ← e₁.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  match m with
  | `(@monoid.has_pow %%_ %%_) := prod.snd <$> prove_pow e₁ n₁ c e₂
  | _ := failed
  end
| `(monoid.npow %%e₁ %%e₂) := do
  n₁ ← e₁.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  prod.snd <$> prove_pow e₁ n₁ c e₂
| _ := failed

/-- Given `⊢ p`, returns `(true, ⊢ p = true)`. -/
meta def true_intro (p : expr) : tactic (expr × expr) :=
prod.mk `(true) <$> mk_app ``eq_true_intro [p]

/-- Given `⊢ ¬ p`, returns `(false, ⊢ p = false)`. -/
meta def false_intro (p : expr) : tactic (expr × expr) :=
prod.mk `(false) <$> mk_app ``eq_false_intro [p]

theorem not_refl_false_intro {α} (a : α) : (a ≠ a) = false :=
eq_false_intro $ not_not_intro rfl

/-- Evaluates the inequality operations `=`,`<`,`>`,`≤`,`≥`,`≠` on numerals. -/
meta def eval_ineq : expr → tactic (expr × expr)
| `(%%e₁ < %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  if n₁ < n₂ then
    do (_, p) ← prove_lt_rat c e₁ e₂ n₁ n₂, true_intro p
  else if n₁ = n₂ then do
    (_, p) ← c.mk_app ``lt_irrefl [e₁],
    false_intro p
  else do
    (c, p') ← prove_lt_rat c e₂ e₁ n₂ n₁,
    (_, p) ← c.mk_app ``not_lt_of_gt [e₁, e₂, p'],
    false_intro p
| `(%%e₁ ≤ %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  if n₁ ≤ n₂ then do
    (_, p) ←
      if n₁ = n₂ then c.mk_app ``le_refl [e₁]
      else prove_le_rat c e₁ e₂ n₁ n₂,
    true_intro p
  else do
    (c, p) ← prove_lt_rat c e₂ e₁ n₂ n₁,
    (_, p) ← c.mk_app ``not_le_of_gt [e₁, e₂, p],
    false_intro p
| `(%%e₁ = %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  if n₁ = n₂ then mk_eq_refl e₁ >>= true_intro
  else do (_, p) ← prove_ne c e₁ e₂ n₁ n₂, false_intro p
| `(%%e₁ > %%e₂) := mk_app ``has_lt.lt [e₂, e₁] >>= eval_ineq
| `(%%e₁ ≥ %%e₂) := mk_app ``has_le.le [e₂, e₁] >>= eval_ineq
| `(%%e₁ ≠ %%e₂) := do
  n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
  c ← infer_type e₁ >>= mk_instance_cache,
  if n₁ = n₂ then
    prod.mk `(false) <$> mk_app ``not_refl_false_intro [e₁]
  else do (_, p) ← prove_ne c e₁ e₂ n₁ n₂, true_intro p
| _ := failed

theorem nat_succ_eq (a b c : ℕ) (h₁ : a = b) (h₂ : b + 1 = c) : nat.succ a = c := by rwa h₁

/-- Evaluates the expression `nat.succ ... (nat.succ n)` where `n` is a natural numeral.
(We could also just handle `nat.succ n` here and rely on `simp` to work bottom up, but we figure
that towers of successors coming from e.g. `induction` are a common case.) -/
meta def prove_nat_succ (ic : instance_cache) : expr → tactic (instance_cache × ℕ × expr × expr)
| `(nat.succ %%a) := do
  (ic, n, b, p₁) ← prove_nat_succ a,
  let n' := n + 1,
  (ic, c) ← ic.of_nat n',
  (ic, p₂) ← prove_add_nat ic b `(1) c,
  return (ic, n', c, `(nat_succ_eq).mk_app [a, b, c, p₁, p₂])
| e := do
  n ← e.to_nat,
  p ← mk_eq_refl e,
  return (ic, n, e, p)

lemma nat_div (a b q r m : ℕ) (hm : q * b = m) (h : r + m = a) (h₂ : r < b) : a / b = q :=
by rw [← h, ← hm, nat.add_mul_div_right _ _ (lt_of_le_of_lt (nat.zero_le _) h₂),
       nat.div_eq_of_lt h₂, zero_add]

lemma int_div (a b q r m : ℤ) (hm : q * b = m) (h : r + m = a) (h₁ : 0 ≤ r) (h₂ : r < b) :
  a / b = q :=
by rw [← h, ← hm, int.add_mul_div_right _ _ (ne_of_gt (lt_of_le_of_lt h₁ h₂)),
       int.div_eq_zero_of_lt h₁ h₂, zero_add]

lemma nat_mod (a b q r m : ℕ) (hm : q * b = m) (h : r + m = a) (h₂ : r < b) : a % b = r :=
by rw [← h, ← hm, nat.add_mul_mod_self_right, nat.mod_eq_of_lt h₂]

lemma int_mod (a b q r m : ℤ) (hm : q * b = m) (h : r + m = a) (h₁ : 0 ≤ r) (h₂ : r < b) :
  a % b = r :=
by rw [← h, ← hm, int.add_mul_mod_self, int.mod_eq_of_lt h₁ h₂]

lemma int_div_neg (a b c' c : ℤ) (h : a / b = c') (h₂ : -c' = c) : a / -b = c :=
h₂ ▸ h ▸ int.div_neg _ _

lemma int_mod_neg (a b c : ℤ) (h : a % b = c) : a % -b = c :=
(int.mod_neg _ _).trans h

/-- Given `a`,`b` numerals in `nat` or `int`,
  * `prove_div_mod ic a b ff` returns `(c, ⊢ a / b = c)`
  * `prove_div_mod ic a b tt` returns `(c, ⊢ a % b = c)`
-/
meta def prove_div_mod (ic : instance_cache) :
  expr → expr → bool → tactic (instance_cache × expr × expr)
| a b mod :=
  match match_neg b with
  | some b := do
    (ic, c', p) ← prove_div_mod a b mod,
    if mod then
      return (ic, c', `(int_mod_neg).mk_app [a, b, c', p])
    else do
      (ic, c, p₂) ← prove_neg ic c',
      return (ic, c, `(int_div_neg).mk_app [a, b, c', c, p, p₂])
  | none := do
    nb ← b.to_nat,
    na ← a.to_int,
    let nq := na / nb,
    let nr := na % nb,
    let nm := nq * nr,
    (ic, q) ← ic.of_int nq,
    (ic, r) ← ic.of_int nr,
    (ic, m, pm) ← prove_mul_rat ic q b (rat.of_int nq) (rat.of_int nb),
    (ic, p) ← prove_add_rat ic r m a (rat.of_int nr) (rat.of_int nm) (rat.of_int na),
    (ic, p') ← prove_lt_nat ic r b,
    if ic.α = `(nat) then
      if mod then return (ic, r, `(nat_mod).mk_app [a, b, q, r, m, pm, p, p'])
      else        return (ic, q, `(nat_div).mk_app [a, b, q, r, m, pm, p, p'])
    else if ic.α = `(int) then do
      (ic, p₀) ← prove_nonneg ic r,
      if mod then return (ic, r, `(int_mod).mk_app [a, b, q, r, m, pm, p, p₀, p'])
      else        return (ic, q, `(int_div).mk_app [a, b, q, r, m, pm, p, p₀, p'])
    else failed
  end

theorem dvd_eq_nat (a b c : ℕ) (p) (h₁ : b % a = c) (h₂ : (c = 0) = p) : (a ∣ b) = p :=
(propext $ by rw [← h₁, nat.dvd_iff_mod_eq_zero]).trans h₂
theorem dvd_eq_int (a b c : ℤ) (p) (h₁ : b % a = c) (h₂ : (c = 0) = p) : (a ∣ b) = p :=
(propext $ by rw [← h₁, int.dvd_iff_mod_eq_zero]).trans h₂

theorem int_to_nat_pos (a : ℤ) (b : ℕ) (h : (by haveI := @nat.cast_coe ℤ; exact b : ℤ) = a) :
  a.to_nat = b := by rw ← h; simp
theorem int_to_nat_neg (a : ℤ) (h : 0 < a) : (-a).to_nat = 0 :=
by simp [int.to_nat_zero_of_neg, h]

theorem nat_abs_pos (a : ℤ) (b : ℕ) (h : (by haveI := @nat.cast_coe ℤ; exact b : ℤ) = a) :
  a.nat_abs = b := by rw ← h; simp
theorem nat_abs_neg (a : ℤ) (b : ℕ) (h : (by haveI := @nat.cast_coe ℤ; exact b : ℤ) = a) :
  (-a).nat_abs = b := by rw ← h; simp

theorem neg_succ_of_nat (a b : ℕ) (c : ℤ) (h₁ : a + 1 = b)
  (h₂ : (by haveI := @nat.cast_coe ℤ; exact b : ℤ) = c) :
  -[1+ a] = -c := by rw [← h₂, ← h₁, int.nat_cast_eq_coe_nat]; refl

/-- Evaluates some extra numeric operations on `nat` and `int`, specifically
`nat.succ`, `/` and `%`, and `∣` (divisibility). -/
meta def eval_nat_int_ext : expr → tactic (expr × expr)
| e@`(nat.succ _) := do
  ic ← mk_instance_cache `(ℕ),
  (_, _, ep) ← prove_nat_succ ic e,
  return ep
| `(%%a / %%b) := do
  c ← infer_type a >>= mk_instance_cache,
  prod.snd <$> prove_div_mod c a b ff
| `(%%a % %%b) := do
  c ← infer_type a >>= mk_instance_cache,
  prod.snd <$> prove_div_mod c a b tt
| `(%%a ∣ %%b) := do
  α ← infer_type a,
  ic ← mk_instance_cache α,
  th ← if α = `(nat) then return (`(dvd_eq_nat):expr) else
       if α = `(int) then return `(dvd_eq_int) else failed,
  (ic, c, p₁) ← prove_div_mod ic b a tt,
  (ic, z) ← ic.mk_app ``has_zero.zero [],
  (e', p₂) ← mk_app ``eq [c, z] >>= eval_ineq,
  return (e', th.mk_app [a, b, c, e', p₁, p₂])
| `(int.to_nat %%a) := do
  n ← a.to_int,
  ic ← mk_instance_cache `(ℤ),
  if n ≥ 0 then do
    nc ← mk_instance_cache `(ℕ),
    (_, _, b, p) ← prove_nat_uncast ic nc a,
    pure (b, `(int_to_nat_pos).mk_app [a, b, p])
  else do
    a ← match_neg a,
    (_, p) ← prove_pos ic a,
    pure (`(0), `(int_to_nat_neg).mk_app [a, p])
| `(int.nat_abs %%a) := do
  n ← a.to_int,
  ic ← mk_instance_cache `(ℤ),
  nc ← mk_instance_cache `(ℕ),
  if n ≥ 0 then do
    (_, _, b, p) ← prove_nat_uncast ic nc a,
    pure (b, `(nat_abs_pos).mk_app [a, b, p])
  else do
    a ← match_neg a,
    (_, _, b, p) ← prove_nat_uncast ic nc a,
    pure (b, `(nat_abs_neg).mk_app [a, b, p])
| `(int.neg_succ_of_nat %%a) := do
  na ← a.to_nat,
  ic ← mk_instance_cache `(ℤ),
  nc ← mk_instance_cache `(ℕ),
  let nb := na + 1,
  (nc, b) ← nc.of_nat nb,
  (nc, p₁) ← prove_add_nat nc a `(1) b,
  (ic, c) ← ic.of_nat nb,
  (_, _, _, p₂) ← prove_nat_uncast ic nc c,
  pure (`(-%%c : ℤ), `(neg_succ_of_nat).mk_app [a, b, c, p₁, p₂])
| _ := failed

theorem int_to_nat_cast (a : ℕ) (b : ℤ)
  (h : (by haveI := @nat.cast_coe ℤ; exact a : ℤ) = b) :
  ↑a = b := eq.trans (by simp) h

/-- Evaluates the `↑n` cast operation from `ℕ`, `ℤ`, `ℚ` to an arbitrary type `α`. -/
meta def eval_cast : expr → tactic (expr × expr)
| `(@coe ℕ %%α %%inst %%a) := do
  if inst.is_app_of ``coe_to_lift then
    if inst.app_arg.is_app_of ``nat.cast_coe then do
      n ← a.to_nat,
      ic ← mk_instance_cache α,
      nc ← mk_instance_cache `(ℕ),
      (ic, b) ← ic.of_nat n,
      (_, _, _, p) ← prove_nat_uncast ic nc b,
      pure (b, p)
    else if inst.app_arg.is_app_of ``int.cast_coe then do
      n ← a.to_int,
      ic ← mk_instance_cache α,
      zc ← mk_instance_cache `(ℤ),
      (ic, b) ← ic.of_int n,
      (_, _, _, p) ← prove_int_uncast ic zc b,
      pure (b, p)
    else if inst.app_arg.is_app_of ``int.cast_coe then do
      n ← a.to_rat,
      cz_inst ← mk_mapp ``char_zero [α, none, none] >>= mk_instance,
      ic ← mk_instance_cache α,
      qc ← mk_instance_cache `(ℚ),
        (ic, b) ← ic.of_rat n,
      (_, _, _, p) ← prove_rat_uncast ic qc cz_inst b n,
      pure (b, p)
    else failed
  else if inst = `(@coe_base nat int int.has_coe) then do
    n ← a.to_nat,
    ic ← mk_instance_cache `(ℤ),
    nc ← mk_instance_cache `(ℕ),
    (ic, b) ← ic.of_nat n,
    (_, _, _, p) ← prove_nat_uncast ic nc b,
    pure (b, `(int_to_nat_cast).mk_app [a, b, p])
  else failed
| _ := failed

/-- This version of `derive` does not fail when the input is already a numeral -/
meta def derive.step (e : expr) : tactic (expr × expr) :=
eval_field e <|> eval_pow e <|> eval_ineq e <|> eval_cast e <|> eval_nat_int_ext e

/-- An attribute for adding additional extensions to `norm_num`. To use this attribute, put
`@[norm_num]` on a tactic of type `expr → tactic (expr × expr)`; the tactic will be called on
subterms by `norm_num`, and it is responsible for identifying that the expression is a numerical
function applied to numerals, for example `nat.fib 17`, and should return the reduced numerical
expression (which must be in `norm_num`-normal form: a natural or rational numeral, i.e. `37`,
`12 / 7` or `-(2 / 3)`, although this can be an expression in any type), and the proof that the
original expression is equal to the rewritten expression.

Failure is used to indicate that this tactic does not apply to the term. For performance reasons,
it is best to detect non-applicability as soon as possible so that the next tactic can have a go,
so generally it will start with a pattern match and then checking that the arguments to the term
are numerals or of the appropriate form, followed by proof construction, which should not fail.

Propositions are treated like any other term. The normal form for propositions is `true` or
`false`, so it should produce a proof of the form `p = true` or `p = false`. `eq_true_intro` can be
used to help here.
-/
@[user_attribute]
protected meta def attr : user_attribute (expr → tactic (expr × expr)) unit :=
{ name      := `norm_num,
  descr     := "Add norm_num derivers",
  cache_cfg :=
  { mk_cache := λ ns, do {
      t ← ns.mfoldl
        (λ (t : expr → tactic (expr × expr)) n, do
          t' ← eval_expr (expr → tactic (expr × expr)) (expr.const n []),
          pure (λ e, t' e <|> t e))
        (λ _, failed),
      pure (λ e, derive.step e <|> t e) },
    dependencies := [] } }

add_tactic_doc
{ name := "norm_num",
  category := doc_category.attr,
  decl_names := [`norm_num.attr],
  tags := ["arithmetic", "decision_procedure"] }

/-- Look up the `norm_num` extensions in the cache and return a tactic extending `derive.step` with
additional reduction procedures. -/
meta def get_step : tactic (expr → tactic (expr × expr)) := norm_num.attr.get_cache

/-- Simplify an expression bottom-up using `step` to simplify the subexpressions. -/
meta def derive' (step : expr → tactic (expr × expr))
  : expr → tactic (expr × expr) | e :=
do e ← instantiate_mvars e,
   (_, e', pr) ←
    ext_simplify_core () {} simp_lemmas.mk (λ _, failed) (λ _ _ _ _ _, failed)
      (λ _ _ _ _ e,
        do (new_e, pr) ← step e,
           guard (¬ new_e =ₐ e),
           return ((), new_e, some pr, tt))
      `eq e,
    return (e', pr)

/-- Simplify an expression bottom-up using the default `norm_num` set to simplify the
subexpressions. -/
meta def derive (e : expr) : tactic (expr × expr) := do f ← get_step, derive' f e

end norm_num

/-- Basic version of `norm_num` that does not call `simp`. It uses the provided `step` tactic
to simplify the expression; use `get_step` to get the default `norm_num` set and `derive.step` for
the basic builtin set of simplifications. -/
meta def tactic.norm_num1 (step : expr → tactic (expr × expr))
  (loc : interactive.loc) : tactic unit :=
do ns ← loc.get_locals,
   success ← tactic.replace_at (norm_num.derive' step) ns loc.include_goal,
   when loc.include_goal $ try tactic.triv,
   when (¬ ns.empty) $ try tactic.contradiction,
   monad.unlessb success $ done <|> fail "norm_num failed to simplify"

/-- Normalize numerical expressions. It uses the provided `step` tactic to simplify the expression;
use `get_step` to get the default `norm_num` set and `derive.step` for the basic builtin set of
simplifications. -/
meta def tactic.norm_num (step : expr → tactic (expr × expr))
  (hs : list simp_arg_type) (l : interactive.loc) : tactic unit :=
repeat1 $ orelse' (tactic.norm_num1 step l) $
interactive.simp_core {} (tactic.norm_num1 step (interactive.loc.ns [none]))
  ff (simp_arg_type.except ``one_div :: hs) [] l >> skip

namespace tactic.interactive
open norm_num interactive interactive.types

/-- Basic version of `norm_num` that does not call `simp`. -/
meta def norm_num1 (loc : parse location) : tactic unit :=
do f ← get_step, tactic.norm_num1 f loc

/-- Normalize numerical expressions. Supports the operations
`+` `-` `*` `/` `^` and `%` over numerical types such as
`ℕ`, `ℤ`, `ℚ`, `ℝ`, `ℂ` and some general algebraic types,
and can prove goals of the form `A = B`, `A ≠ B`, `A < B` and `A ≤ B`,
where `A` and `B` are numerical expressions.
It also has a relatively simple primality prover. -/
meta def norm_num (hs : parse simp_arg_list) (l : parse location) : tactic unit :=
do f ← get_step, tactic.norm_num f hs l

add_hint_tactic "norm_num"

/-- Normalizes a numerical expression and tries to close the goal with the result. -/
meta def apply_normed (x : parse texpr) : tactic unit :=
do x₁ ← to_expr x,
  (x₂,_) ← derive x₁,
  tactic.exact x₂

/--
Normalises numerical expressions. It supports the operations `+` `-` `*` `/` `^` and `%` over
numerical types such as `ℕ`, `ℤ`, `ℚ`, `ℝ`, `ℂ`, and can prove goals of the form `A = B`, `A ≠ B`,
`A < B` and `A ≤ B`, where `A` and `B` are
numerical expressions. It also has a relatively simple primality prover.
```lean
import data.real.basic

example : (2 : ℝ) + 2 = 4 := by norm_num
example : (12345.2 : ℝ) ≠ 12345.3 := by norm_num
example : (73 : ℝ) < 789/2 := by norm_num
example : 123456789 + 987654321 = 1111111110 := by norm_num
example (R : Type*) [ring R] : (2 : R) + 2 = 4 := by norm_num
example (F : Type*) [linear_ordered_field F] : (2 : F) + 2 < 5 := by norm_num
example : nat.prime (2^13 - 1) := by norm_num
example : ¬ nat.prime (2^11 - 1) := by norm_num
example (x : ℝ) (h : x = 123 + 456) : x = 579 := by norm_num at h; assumption
```

The variant `norm_num1` does not call `simp`.

Both `norm_num` and `norm_num1` can be called inside the `conv` tactic.

The tactic `apply_normed` normalises a numerical expression and tries to close the goal with
the result. Compare:
```lean
def a : ℕ := 2^100
#print a -- 2 ^ 100

def normed_a : ℕ := by apply_normed 2^100
#print normed_a -- 1267650600228229401496703205376
```
-/
add_tactic_doc
{ name        := "norm_num",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.norm_num1, `tactic.interactive.norm_num,
                  `tactic.interactive.apply_normed],
  tags        := ["arithmetic", "decision procedure"] }

end tactic.interactive

namespace conv.interactive
open conv interactive tactic.interactive
open norm_num (derive)

/-- Basic version of `norm_num` that does not call `simp`. -/
meta def norm_num1 : conv unit := replace_lhs derive

/-- Normalize numerical expressions. Supports the operations
`+` `-` `*` `/` `^` and `%` over numerical types such as
`ℕ`, `ℤ`, `ℚ`, `ℝ`, `ℂ` and some general algebraic types,
and can prove goals of the form `A = B`, `A ≠ B`, `A < B` and `A ≤ B`,
where `A` and `B` are numerical expressions.
It also has a relatively simple primality prover. -/
meta def norm_num (hs : parse simp_arg_list) : conv unit :=
repeat1 $ orelse' norm_num1 $
conv.interactive.simp ff (simp_arg_type.except ``one_div :: hs) []
  { discharger := tactic.interactive.norm_num1 (loc.ns [none]) }

end conv.interactive