/-
Copyright 2021 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import measure_theory.measurable_space

import measure_theory.measure_space
import measure_theory.outer_measure
import measure_theory.lebesgue_measure
import measure_theory.integration

import measure_theory.borel_space
import data.set.countable
import formal_ml.nnreal
import formal_ml.sum
import formal_ml.lattice
import formal_ml.measurable_space
import formal_ml.classical
import data.equiv.list
import formal_ml.prod_measure
import formal_ml.finite_pi_measure
import formal_ml.probability_space
import formal_ml.monotone_class

/-!
  This file focuses on more esoteric proofs that random variables are identical.
  In particular, given two random variables X Y with a common measurable space as a codomain,
  where the codomain is generated by some set of measurable sets S.
  X and Y are identical if they are identical on measurable sets in S, assuming S
  has some particular properties. The first is that S is an algebra, i.e. S has the
  universal set and is closed under set difference.

  An alternative is that S is (basically) a semi-algebra, i.e. it has the empty set
  and is closed under intersection, and semi-closed under complement. Normally, a
  semi-algebra would require the universal set, but that is not required for this
  purpose.

  This is most useful for proving independent and identical random variables, when
  considered as an aggregate random variable, are identical.

  The core is the monotone class theorem, measurable_space.generate_from_monotone_class.
-/

lemma random_variable_identical_on_algebra''' {Ω₁ Ω₂ α:Type*} (s: set (set α))
  (A:s.is_algebra)
  {P₁:probability_space Ω₁} {P₂:probability_space Ω₂}
  {X₁:P₁ →ᵣ (measurable_space.generate_from s)}
  {X₂:P₂ →ᵣ (measurable_space.generate_from s)}:
  (∀ (T:measurable_setB (measurable_space.generate_from s)),
   T.val ∈ s → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) →
  random_variable_identical X₁ X₂ :=
begin
  intros h3 U,
  cases U,
  have AM := A.monotone_class,
  have h7:∀ {T':set α}, s.monotone_class T' →
          (measurable_space.generate_from s).measurable_set' T',
  { intros T h7_1,
    rw measurable_space.generate_from_monotone_class at h7_1,
    simp [measurable_space.generate_from],
    apply h7_1, apply A },
  have h4:measurable_space.generate_measurable s U_val,
  { simp [measurable_space.generate_from] at U_property,
    apply U_property },
  have h5:s.monotone_class U_val,
  { rw measurable_space.generate_from_monotone_class,
    apply h4, apply A },
  induction h5 with U' h_U' f h_rec h_mono h_ind f h_rec h_mono h_ind,
  { apply h3, apply h_U' },
  { have h6:(∀ᵣ i, X₁ ∈ᵣ ⟨f i, h7 (h_rec i)⟩) = (X₁ ∈ᵣ ⟨set.Inter f, U_property⟩) ,
    { apply event.eq, simp, ext ω, split; intros h6_1; simp at h6_1; simp [h6_1], },
    rw ← h6,
    have h7:(∀ᵣ i, X₂ ∈ᵣ ⟨f i, h7 (h_rec i)⟩) = (X₂ ∈ᵣ ⟨set.Inter f, U_property⟩) ,
    { apply event.eq, simp, ext ω, split; intros h7_1; simp at h7_1; simp [h7_1], },
    rw ← h7,
    rw Pr_forall_revent_eq_infi,
    rw Pr_forall_revent_eq_infi,
    have h8:(λ (i : ℕ), Pr[X₁ ∈ᵣ ⟨f i, _⟩]) = λ (i : ℕ), Pr[X₂ ∈ᵣ ⟨f i, _⟩],
    { ext1 i, apply h_ind,
      rw ← measurable_space.generate_from_monotone_class,
      apply h_rec, apply A },
    rw h8,
    simp, apply h_mono,
    simp, apply h_mono },
  { have h9:(∃ᵣ i, X₁ ∈ᵣ ⟨f i, h7 (h_rec i)⟩) = (X₁ ∈ᵣ ⟨set.Union f, U_property⟩) ,
    { apply event.eq, simp, ext ω, split; intros h9_1; simp at h9_1; simp [h9_1], },
    rw ← h9,
    have h10:(∃ᵣ i, X₂ ∈ᵣ ⟨f i, h7 (h_rec i)⟩) = (X₂ ∈ᵣ ⟨set.Union f, U_property⟩) ,
    { apply event.eq, simp, ext ω, split; intros h10_1; simp at h10_1; simp [h10_1] },
    rw ← h10,
    rw Pr_exists_revent_eq_supr,
    rw Pr_exists_revent_eq_supr,
    have h11:(λ (i : ℕ), Pr[X₁ ∈ᵣ ⟨f i, _⟩]) = λ (i : ℕ), Pr[X₂ ∈ᵣ ⟨f i, _⟩],
    { ext1 i, apply h_ind,
      rw ← measurable_space.generate_from_monotone_class,
      apply h_rec, apply A },
    rw h11,
    simp, apply h_mono,
    simp, apply h_mono },
end

lemma random_variable_identical_on_algebra {Ω₁ Ω₂ α:Type*} (s: set (set α))
  {P₁:probability_space Ω₁} {P₂:probability_space Ω₂}
  {X₁:P₁ →ᵣ (measurable_space.generate_from s)}
  {X₂:P₂ →ᵣ (measurable_space.generate_from s)}:
  (set.univ ∈ s) →
  (∀ a b, a∈ s → b ∈ s → a \ b ∈ s) →
  (∀ (T:measurable_setB (measurable_space.generate_from s)),
   T.val ∈ s → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) →
  random_variable_identical X₁ X₂ :=
begin
  intros h1 h2 h3,
  apply random_variable_identical_on_algebra''',
  apply set.is_algebra.mk h1 h2,
  apply h3,
end

/- This allows for the measurable space to be generated from a different
   set. -/
lemma random_variable_identical_on_algebra' {Ω₁ Ω₂ α:Type*} (s: set (set α))
  (M:measurable_space α)
  {P₁:probability_space Ω₁} {P₂:probability_space Ω₂}
  {X₁:P₁ →ᵣ M}
  {X₂:P₂ →ᵣ M}:
  (set.univ ∈ s) →
  (∀ a b, a∈ s → b ∈ s → a \ b ∈ s) →
  (M = measurable_space.generate_from s) →
  (∀ (T:measurable_setB M),
   T.val ∈ s → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) →
  random_variable_identical X₁ X₂ :=
begin
  intros h1 h2 h3 h4 T',
  tactic.unfreeze_local_instances,
  subst M,
  apply random_variable_identical_on_algebra,
  apply h1,
  apply h2,
  apply h4,
end

#check measurable_space.generate_from
lemma random_variable_identical_on_algebra'' {Ω₁ Ω₂ α:Type*} (s t: set (set α))
  {P₁:probability_space Ω₁} {P₂:probability_space Ω₂}
  {X₁:P₁ →ᵣ (measurable_space.generate_from t)}
  {X₂:P₂ →ᵣ (measurable_space.generate_from t)}:
  (set.univ ∈ s) →
  (∀ a b, a∈ s → b ∈ s → a \ b ∈ s) →
  (t ⊆ s) →
  (∀ a∈ s, (measurable_space.generate_from t).measurable_set' a) →
  (∀ (T:measurable_setB (measurable_space.generate_from t)),
   T.val ∈ s → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) →
  random_variable_identical X₁ X₂ :=
begin
  intros h1 h2 h3 h4 h5,
  have h6:(measurable_space.generate_from t) = (measurable_space.generate_from s),
  { apply le_antisymm;
    apply measurable_space.generate_from_le;
    intros a h_a,
    { simp [measurable_space.generate_from],
      apply measurable_space.generate_measurable.basic,
      apply h3, apply h_a },
    apply h4, apply h_a },
  apply random_variable_identical_on_algebra',
  apply h1,
  apply h2,
  apply h6,
  apply h5,
end

lemma equality_disjoint_union_closure {Ω₁ Ω₂ α:Type*} (S : set (set α))
  {P₁:probability_space Ω₁} {P₂:probability_space Ω₂}
  {X₁:P₁ →ᵣ (measurable_space.generate_from S)}
  {X₂:P₂ →ᵣ (measurable_space.generate_from S)}:
  (∀ (T:measurable_setB (measurable_space.generate_from S)),
   T.val ∈ S → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) →
  (∀ (T:measurable_setB (measurable_space.generate_from S)),
   T.val ∈ S.disjoint_union_closure → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) :=
begin
  intros h4,
  intros T h_T, cases T,
    rw set.mem_disjoint_union_closure_iff at h_T,
    cases h_T with m h_T,
    cases h_T with f h_T,
    cases h_T with h_f h_T,
    cases h_T with h_f_pairwise h_s_def,
    simp at h_s_def,
    subst T_val,
    have h_X1:X₁ ∈ᵣ ⟨set.Union f, T_property⟩ = (eany (λ (i:fin m), X₁ ∈ᵣ ⟨f i,
             measurable_space.measurable_set_generate_from (h_f i)⟩)),
    { apply event.eq, ext ω, split; intros h_X1_1; simp at h_X1_1; cases h_X1_1 with i
      h_X1_1; simp [h_X1_1]; apply exists.intro i; apply h_X1_1 },
    have h_X2:X₂ ∈ᵣ ⟨set.Union f, T_property⟩ = (eany (λ (i:fin m), X₂ ∈ᵣ ⟨f i,
             measurable_space.measurable_set_generate_from (h_f i)⟩)),
    { apply event.eq, ext ω, split; intros h_X1_1; simp at h_X1_1; cases h_X1_1 with i
      h_X1_1; simp [h_X1_1]; apply exists.intro i; apply h_X1_1 },
    rw h_X1, rw h_X2,
    rw Pr_eany_sum,
    rw Pr_eany_sum,
    { congr, ext1 b, apply h4, simp, apply h_f },
    { intros i j h_ne, simp only [function.on_fun], apply disjoint_preimage,
      apply h_f_pairwise, apply h_ne },
    { intros i j h_ne, simp only [function.on_fun], apply disjoint_preimage,
      apply h_f_pairwise, apply h_ne },
end

#check 3
#check 3

lemma random_variable_identical_on_semialgebra''' {Ω₁ Ω₂ α:Type*} (S : set (set α))
  (A:S.is_semialgebra)
  {P₁:probability_space Ω₁} {P₂:probability_space Ω₂}
  {X₁:P₁ →ᵣ (measurable_space.generate_from S)}
  {X₂:P₂ →ᵣ (measurable_space.generate_from S)}:
  (∀ (T:measurable_setB (measurable_space.generate_from S)),
   T.val ∈ S → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) →
  random_variable_identical X₁ X₂ :=
begin
  intros h4,
  have CA := A.disjoint_union_closure,

  apply random_variable_identical_on_algebra'' S.disjoint_union_closure,
  { apply CA.univ },
  { apply CA.diff },
  { intros a h_a, apply set.disjoint_union_closure_self, apply h_a  },
  { intros s h_s,
    rw set.mem_disjoint_union_closure_iff at h_s,
    cases h_s with m h_s,
    cases h_s with f h_s,
    cases h_s with h_f h_s,
    cases h_s with h_f_pairwise h_s_def,
    subst s,
    haveI:fintype (fin m) := fin.fintype m,
    haveI:encodable (fin m) := fintype.encodable (fin m),
    simp, apply measurable_set.Union,
    intro b, apply measurable_space.measurable_set_generate_from,
    apply h_f },
  { apply equality_disjoint_union_closure,
    apply h4 },
end

#check 12
#check 3

lemma random_variable_identical_on_semialgebra {Ω₁ Ω₂ α:Type*} (S : set (set α))
  {P₁:probability_space Ω₁} {P₂:probability_space Ω₂}
  {X₁:P₁ →ᵣ (measurable_space.generate_from S)}
  {X₂:P₂ →ᵣ (measurable_space.generate_from S)}:
  (∀ s t∈ S, s ∩ t ∈ S) →
  (∀ s ∈ S, sᶜ ∈ S.disjoint_union_closure) →
  (∅ ∈ S) →
  (@set.univ α ∈ S) →
  (∀ (T:measurable_setB (measurable_space.generate_from S)),
   T.val ∈ S → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) →
  random_variable_identical X₁ X₂ :=
begin
  intros h1 h2 h3 h_univ h4,
  have A := set.is_semialgebra.mk h_univ h3 h1 h2,
  apply random_variable_identical_on_semialgebra''',
  apply A,
  apply h4,
end

/- TODO: technically, could remove empty set or the universe, and it would
   still be true. -/
lemma random_variable_identical_on_semialgebra' {Ω₁ Ω₂ α:Type*} (S : set (set α))
  (M:measurable_space α)
  {P₁:probability_space Ω₁} {P₂:probability_space Ω₂}
  {X₁:P₁ →ᵣ M}
  {X₂:P₂ →ᵣ M}:
  (∀ s t∈ S, s ∩ t ∈ S) →
  (∀ s ∈ S, sᶜ ∈ S.disjoint_union_closure) →
  (∅ ∈ S) →
  (set.univ ∈ S) →
  (M = measurable_space.generate_from S) →
  (∀ (T:measurable_setB M),
   T.val ∈ S → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) →
  random_variable_identical X₁ X₂ :=
begin
  intros h1 h2 h3 h_univ h4 h5,
  tactic.unfreeze_local_instances,
  subst M,
  apply random_variable_identical_on_semialgebra,
  apply h1,
  apply h2,
  apply h3,
  apply h_univ,
  apply h5,
end

lemma random_variable_identical_on_semialgebra'' {Ω₁ Ω₂ α:Type*} (s t: set (set α))
  {P₁:probability_space Ω₁} {P₂:probability_space Ω₂}
  {X₁:P₁ →ᵣ (measurable_space.generate_from t)}
  {X₂:P₂ →ᵣ (measurable_space.generate_from t)}:
  (∀ a b∈ s, a ∩ b ∈ s) →
  (∀ a ∈ s, aᶜ ∈ s.disjoint_union_closure) →
  (∅ ∈ s) →
  (set.univ ∈ s) →
  (t ⊆ s) →
  (∀ a∈ s, (measurable_space.generate_from t).measurable_set' a) →
  (∀ (T:measurable_setB (measurable_space.generate_from t)),
   T.val ∈ s → Pr[X₁ ∈ᵣ T] = Pr[X₂ ∈ᵣ T]) →
  random_variable_identical X₁ X₂ :=
begin
  intros h1 h2 h_empty h_univ h3 h4 h5,
  have h6:(measurable_space.generate_from t) = (measurable_space.generate_from s),
  { apply le_antisymm;
    apply measurable_space.generate_from_le;
    intros a h_a,
    { simp [measurable_space.generate_from],
      apply measurable_space.generate_measurable.basic,
      apply h3, apply h_a },
    apply h4, apply h_a },
  apply random_variable_identical_on_semialgebra',
  apply h1,
  apply h2,
  apply h_empty,
  apply h_univ,
  apply h6,
  apply h5,
end


/-
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

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 ▸ add_tsub_cancel_left _ _
theorem sub_nat_neg (a b c : ℕ) (h : a + c = b) : a - b = 0 :=
tsub_eq_zero_iff_le.mpr $ 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 only [int.to_nat_of_nonpos, h.le, neg_nonpos]

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.

Add-on tactics marked as `@[norm_num]` can extend the behavior of `norm_num` to include other
functions. This is used to support several other functions on `nat` like `prime`, `min_fac` and
`factors`.
```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