import QL.FOL.deduction

universes u v
open_locale logic_symbol

namespace fol
open logic subformula
variables (L : language.{u})

structure Structure (L : language.{u}) :=
(dom : Type u)
(fn : ∀ {n}, L.fn n → (fin n → dom) → dom)
(pr : ∀ {n}, L.pr n → (fin n → dom) → Prop)

instance Structure_coe {L : language} : has_coe_to_sort (Structure L) (Type*) := ⟨Structure.dom⟩

structure nonempty_Structure (L : language.{u}) extends Structure L :=
(dom_inhabited : inhabited dom)

instance nonempty_to_Structure_coe (L : language.{u}) : has_coe_t (nonempty_Structure L) (Structure L) := ⟨nonempty_Structure.to_Structure⟩

instance nonempty_Structure_dom_coe {L : language} : has_coe_to_sort (nonempty_Structure L) (Type*) :=
⟨λ S, ((S : Structure L) : Type*)⟩

instance (S : nonempty_Structure L) : inhabited S := S.dom_inhabited

structure finite_Structure (L : language.{u}) extends Structure L :=
(dom_finite : finite dom)

instance finite_Structure_coe (L : language.{u}) : has_coe_t (finite_Structure L) (Structure L) := ⟨finite_Structure.to_Structure⟩

variables {L} {μ : Type v} {μ₁ : Type*} {μ₂ : Type*}

open subterm subformula

namespace  subterm
variables (S : Structure L) {n : ℕ} (Φ : μ → S) (e : fin n → S)

@[simp] def val (Φ : μ → S) (e : fin n → S) : subterm L μ n → S
| (&x)           := Φ x
| (#x)           := e x
| (function f v) := S.fn f (λ i, (v i).val)

lemma val_rew (s : μ₁ → subterm L μ₂ n) (Φ : μ₂ → S) (e : fin n → S) (t : subterm L μ₁ n) :
  (rew s t).val S Φ e = t.val S (λ x, val S Φ e (s x)) e :=
by induction t; simp*

lemma val_map (f : μ₁ → μ₂) (Φ : μ₂ → S) (e : fin n → S) (t : subterm L μ₁ n) :
  (map f t).val S Φ e = t.val S (λ x, Φ (f x)) e :=
by simp[map, val_rew]

lemma val_subst (u : subterm L μ n) (t : subterm L μ (n + 1)) :
  (subst u t).val S Φ e = t.val S Φ (e <* u.val S Φ e) :=
by { induction t; simp*, case var : x { refine fin.last_cases _ _ x; simp } }

lemma val_lift (x : S) (t : subterm L μ n) :
  t.lift.val S Φ (x *> e) = t.val S Φ e :=
by induction t; simp*

section bounded_subterm
variables {m : ℕ} {Ψ : fin m → S}

lemma val_mlift (x : S) (t : bounded_subterm L m n) :
  t.mlift.val S (Ψ <* x) e = t.val S Ψ e :=
by simp[mlift, val_rew, val_map]

lemma val_push (x : S) (e : fin n → S) (t : bounded_subterm L m (n + 1)) :
  val S (Ψ <* x) e t.push = val S Ψ (e <* x) t :=
by { induction t; simp*, case var : u { refine fin.last_cases _ _ u; simp } }

lemma val_pull (x : S) (e : fin n → S) (t : bounded_subterm L (m + 1) n) :
  val S Ψ (e <* x) t.pull = val S (Ψ <* x) e t :=
by { induction t; simp*, case metavar : u { refine fin.last_cases _ _ u; simp } }

end bounded_subterm

end  subterm

namespace subformula
variables {μ μ₁ μ₂} (S : Structure L) {n : ℕ} {Φ : μ → S} {e : fin n → S}

@[simp] def subval' (Φ : μ → S) : ∀ {n} (e : fin n → S), subformula L μ n → Prop
| n _ verum          := true
| n e (relation p v) := S.pr p (subterm.val S Φ e ∘ v)
| n e (imply p q)    := p.subval' e → q.subval' e
| n e (neg p)        := ¬(p.subval' e)
| n e (fal p)        := ∀ x : S.dom, (p.subval' (x *> e))

@[irreducible] def subval (Φ : μ → S) (e : fin n → S) : subformula L μ n →ₗ Prop :=
{ to_fun := subval' S Φ e,
  map_neg' := λ _, by refl,
  map_imply' := λ _ _, by refl,
  map_and' := λ p q, by unfold has_inf.inf; simp[and]; refl,
  map_or' := λ p q, by unfold has_sup.sup; simp[or, ←or_iff_not_imp_left]; refl,
  map_top' := by refl,
  map_bot' := by simp[bot_def]; unfold has_top.top has_negation.neg; simp }

@[reducible] def val (Φ : μ → S) : formula L μ →ₗ Prop := subformula.subval S Φ fin.nil

@[simp] lemma subval_relation {p} {r : L.pr p} {v} :
  subval S Φ e (relation r v) ↔ S.pr r (λ i, subterm.val S Φ e (v i)) :=  by simp[subval]; refl

@[simp] lemma subval_fal {p : subformula L μ (n + 1)} :
  subval S Φ e (∀'p) ↔ ∀ x : S, subval S Φ (x *> e) p := by simp[subval]; refl

@[simp] lemma subval_ex {p : subformula L μ (n + 1)} :
  subval S Φ e (∃'p) ↔ ∃ x : S, subval S Φ (x *> e) p := by simp[ex_def]

lemma subval_rew {Φ : μ₂ → S} {n} {e : fin n → S} {s : μ₁ → subterm L μ₂ n} {p : subformula L μ₁ n} :
  subval S Φ e (rew s p) ↔ subval S (λ x, subterm.val S Φ e (s x)) e p :=
by induction p using fol.subformula.ind_on; intros; simp[*, subterm.val_rew, subterm.val_lift]

lemma subval_map {Φ : μ₂ → S} {n} {e : fin n → S} {f : μ₁ → μ₂} {p : subformula L μ₁ n} :
  subval S Φ e (map f p) ↔ subval S (λ x, Φ (f x)) e p :=
by simp[map, subval_rew]

@[simp] lemma subval_subst {n} {p : subformula L μ (n + 1)} : ∀ {e : fin n → S} {t : subterm L μ n},
  subval S Φ e (subst t p) ↔ subval S Φ (e <* subterm.val S Φ e t) p :=
by apply ind_succ_on p; intros; simp[*, subterm.val_subst, subterm.val_lift, fin.left_right_concat_assoc]

section bounded_subformula
variables {m : ℕ} {Ψ : fin m → S}

lemma subval_mlift {x} {p : bounded_subformula L m n} :
  subval S (Ψ <* x) e p.mlift = subval S Ψ e p := by simp[mlift, (∘), subval_map]

lemma subval_push {x} {n} {p : bounded_subformula L m (n + 1)} : ∀ {e : fin n → S},
  subval S (Ψ <* x) e p.push ↔ subval S Ψ (e <* x) p :=
by apply ind_succ_on p; intros; simp[*, subterm.val_push, fin.left_right_concat_assoc]

lemma subval_pull {x} {n} {p : bounded_subformula L (m + 1) n} : ∀ {e : fin n → S},
  subval S Ψ (e <* x) p.pull ↔ subval S (Ψ <* x) e p :=
by induction p using fol.subformula.ind_on generalizing Ψ; intros; simp[*, subterm.val_pull, fin.left_right_concat_assoc]

lemma subval_dummy {x} : ∀ {n} {e : fin n → S} {p : bounded_subformula L m n},
  subval S Ψ (e <* x) p.dummy ↔ subval S Ψ e p :=
by simp[dummy, subval_pull, subval_mlift]

end bounded_subformula

end subformula

namespace nonempty_Structure
variables (M : nonempty_Structure L)

lemma coe_def : (M : Structure L) = M.to_Structure := rfl

@[simp] lemma fn_coe : @Structure.fn L (M : Structure L) = @Structure.fn L M.to_Structure := rfl

@[simp] lemma pr_coe : @Structure.pr L (M : Structure L) = @Structure.pr L M.to_Structure := rfl

instance : inhabited (nonempty_Structure L) :=
⟨{ dom := punit,
   fn := λ k f v, punit.star,
   pr := λ k r v, false,
   dom_inhabited := punit.inhabited }⟩

end nonempty_Structure

namespace Structure

@[ext] lemma ext (S₁ S₂ : Structure L)
  (hdom : @dom L S₁ = @dom L S₂)
  (hfn : ∀ {k} (f : L.fn k), @fn L S₁ k f == @fn L S₂ k f)
  (hpr : ∀ {k} (r : L.pr k), @pr L S₁ k r == @pr L S₂ k r) : S₁ = S₂ :=
begin
  rcases S₁, rcases S₂, simp at hdom ⊢ hfn hpr, refine ⟨hdom, _, _⟩,
  { ext; simp, rintros k k rfl, ext; simp, rintros f f rfl, exact hfn f },
  { ext; simp, rintros k k rfl, ext; simp, rintros r r rfl, exact hpr r }
end

lemma eta (S : Structure L) : ({dom := S.dom, fn := @fn L S, pr := @pr L S} : Structure L) = S :=
by ext; simp

class Structure.proper_equal [L.has_equal] (S : Structure L)
(val_eq : ∀ {n : ℕ} {t u : subterm L μ n} {Φ e}, subformula.subval S Φ e (t =' u) ↔ (t.val S Φ e = u.val S Φ e))

def nonempty (S : Structure L) [c : inhabited S] : nonempty_Structure L :=
{ dom_inhabited := c, ..S }

variables (S : Structure L) [inhabited S]

@[simp] lemma coe_nonempty : (S.nonempty : Type*) = S := rfl

@[simp] lemma to_Structure_nonempty : (S.nonempty : Structure L) = S := by simp[nonempty, nonempty_Structure.coe_def, eta]

instance : inhabited (Structure L) :=
⟨(default : nonempty_Structure L)⟩

end Structure

namespace subformula
variables (S : Structure L) {Φ : μ → S}

notation S` ⊧[`:80 e`] `p :50 := val S e p

variables {S} {p q : formula L μ}

@[simp] lemma models_relation {k} {r : L.pr k} {v} :
  S ⊧[Φ] relation r v ↔ S.pr r (λ i, subterm.val S Φ fin.nil (v i)) := by simp[val]

section bounded
variables {m : ℕ} {Ψ : fin m → S}

@[simp] lemma val_fal {p : bounded_subformula L m 1} :
  S ⊧[Ψ] ∀'p ↔ ∀ x, S ⊧[Ψ <* x] p.push :=
by simp[val, subval_push, fin.concat_zero]

@[simp] lemma val_ex {p : bounded_subformula L m 1} :
  S ⊧[Ψ] ∃'p ↔ ∃ x, S ⊧[Ψ <* x] p.push :=
by simp[val, subval_push, fin.concat_zero]

@[simp] lemma val_subst {p : bounded_subformula L m 1} {t : bounded_subterm L m 0} :
  S ⊧[Ψ] subst t p ↔ S ⊧[Ψ <* subterm.val S Ψ fin.nil t] p.push :=
by simp[val, subval_subst, subval_push]

@[simp] lemma val_mlift {x : S} {p : bounded_subformula L m 0} : S ⊧[Ψ <* x] p.mlift ↔ S ⊧[Ψ] p :=
by simp[val, subval_mlift]

end bounded

end subformula

def models (S : Structure L) (p : formula L μ) : Prop := ∀ e, S ⊧[e] p

instance : semantics (formula L μ) (Structure L) := ⟨models⟩

instance : semantics (formula L μ) (nonempty_Structure L) := ⟨λ S p, (S : Structure L) ⊧ p⟩

namespace Structure

variables {S : Structure L} {σ τ : sentence L}

lemma models_def {p : formula L μ} : S ⊧ p ↔ (∀ e, S ⊧[e] p) := by refl

lemma sentence_models_def :
  S ⊧ σ ↔ S ⊧[fin.nil] σ := by simp[models_def, fin.nil]

@[simp] lemma formula_verum : S ⊧ (⊤ : formula L μ) := by simp[models_def]

@[simp] lemma sentence_falsum : ¬S ⊧ (⊥ : sentence L) := by simp[models_def]

@[simp] lemma sentence_relation {k} (r : L.pr k) (v : fin k → bounded_subterm L 0 0) :
  S ⊧ (relation r v) ↔ S.pr r (subterm.val S fin.nil fin.nil ∘ v) := by simp[sentence_models_def]

@[simp] lemma sentence_imply : S ⊧ σ ⟶ τ ↔ (S ⊧ σ → S ⊧ τ) := by simp[sentence_models_def]

@[simp] lemma sentence_neg : S ⊧ ∼σ ↔ ¬S ⊧ σ := by simp[sentence_models_def]

@[simp] lemma sentence_and : S ⊧ σ ⊓ τ ↔ S ⊧ σ ∧ S ⊧ τ := by simp[sentence_models_def]

@[simp] lemma sentence_or : S ⊧ σ ⊔ τ ↔ S ⊧ σ ∨ S ⊧ τ := by simp[sentence_models_def]

@[simp] lemma sentence_equiv : S ⊧ σ ⟷ τ ↔ (S ⊧ σ ↔ S ⊧ τ) := by simp[sentence_models_def]

instance : semantics.nontrivial (sentence L) (Structure L) :=
⟨by simp[models_def], by simp[models_def]⟩

abbreviation valid (p : formula L μ) : Prop := semantics.valid (Structure L) p

abbreviation satisfiable (p : formula L μ) : Prop := semantics.satisfiable (Structure L) p

lemma valid_def (p : formula L μ) : valid p ↔ ∀ S : Structure L, S ⊧ p := by refl

lemma satisfiable_def (p : formula L μ) : satisfiable p ↔ ∃ S : Structure L, S ⊧ p := by refl

abbreviation Satisfiable (T : preTheory L μ) : Prop := semantics.Satisfiable (Structure L) T

lemma Satisfiable_def (T : preTheory L μ) : Satisfiable T ↔ ∃ S: Structure L, S ⊧ T := by refl

@[simp] lemma sentence_not_valid_iff_satisfiable (σ : sentence L) : ¬valid σ ↔ satisfiable (∼σ) :=
by simp[valid_def, satisfiable_def]

@[simp] lemma models_mlift [inhabited S] {m} {p : bounded_formula L m} : S ⊧ p.mlift ↔ S ⊧ p :=
by{ simp[models_def], split,
    { intros h e,
      have : S ⊧[e <* default] p.mlift, from h _,
      simpa using this },
    { intros h e, rw ←fin.right_concat_eq e, simpa using h (e ∘ fin.cast_succ)} }

end Structure

namespace nonempty_Structure

variables {M : nonempty_Structure L} {σ τ : sentence L} {m : ℕ} {T : bounded_preTheory L m}

lemma models_def {p : formula L μ} :
  M ⊧ p ↔ (∀ e, ↑M ⊧[e] p) := by refl

lemma sentence_models_def {σ : sentence L} :
  M ⊧ σ ↔ ↑M ⊧[fin.nil] σ := by simp[models_def, fin.nil]

@[simp] lemma formula_verum : M ⊧ (⊤ : formula L μ) := by simp[models_def]

@[simp] lemma formula_falsum : ¬M ⊧ (⊥ : formula L μ) := by simp[models_def]

@[simp] lemma sentence_relation {k} {r : L.pr k} {v : fin k → bounded_subterm L 0 0} :
  M ⊧ (relation r v) ↔ M.pr r (subterm.val M fin.nil fin.nil ∘ v) := by simp[sentence_models_def]

@[simp] lemma sentence_imply : M ⊧ σ ⟶ τ ↔ (M ⊧ σ → M ⊧ τ) := by simp[sentence_models_def]

@[simp] lemma sentence_neg : M ⊧ ∼σ ↔ ¬M ⊧ σ := by simp[sentence_models_def]

@[simp] lemma sentence_and : M ⊧ σ ⊓ τ ↔ M ⊧ σ ∧ M ⊧ τ := by simp[sentence_models_def]

@[simp] lemma sentence_or : M ⊧ σ ⊔ τ ↔ M ⊧ σ ∨ M ⊧ τ := by simp[sentence_models_def]

@[simp] lemma sentence_equiv : M ⊧ σ ⟷ τ ↔ (M ⊧ σ ↔ M ⊧ τ) := by simp[sentence_models_def]

instance : semantics.nontrivial (formula L μ) (nonempty_Structure L) :=
⟨by simp[models_def], by simp[models_def]⟩

abbreviation valid (p : formula L μ) : Prop := semantics.valid (nonempty_Structure L) p

abbreviation satisfiable (p : formula L μ) : Prop := semantics.satisfiable (nonempty_Structure L) p

lemma valid_def (p : formula L μ) : valid p ↔ ∀ M : nonempty_Structure L, M ⊧ p := by refl

lemma satisfiable_def (p : formula L μ) : satisfiable p ↔ ∃ M : nonempty_Structure L, M ⊧ p := by refl

abbreviation Satisfiable (T : preTheory L μ) : Prop := semantics.Satisfiable (nonempty_Structure L) T

lemma Satisfiable_def (T : preTheory L μ) : Satisfiable T ↔ ∃ M : nonempty_Structure L, M ⊧ T := by refl

@[simp] lemma sentence_not_valid_iff_satisfiable (σ : sentence L) : ¬valid σ ↔ satisfiable (∼σ) :=
by simp[valid_def, satisfiable_def]

lemma coe_models_iff (p : formula L μ) : (M : Structure L) ⊧ p ↔ M ⊧ p := by refl

@[simp] lemma models_mlift {m} {p : bounded_formula L m} : M ⊧ p.mlift ↔ M ⊧ p :=
by simp[←coe_models_iff]

lemma coe_models_Theory_iff (T : preTheory L μ) : (M : Structure L) ⊧ T ↔ M ⊧ T := by refl

end nonempty_Structure

namespace Structure
open bounded_preTheory
variables {S : Structure L} {σ τ : sentence L} {m : ℕ} {T : bounded_preTheory L m}

lemma nonempty_models_iff [inhabited S] (p : formula L μ) : S.nonempty ⊧ p ↔ S ⊧ p :=
by simp[←nonempty_Structure.coe_models_iff]

lemma nonempty_models_Theory_iff [inhabited S] (T : preTheory L μ) : S.nonempty ⊧ T ↔ S ⊧ T :=
by simp[←nonempty_Structure.coe_models_Theory_iff]

@[simp] lemma models_Theory_mlift [inhabited S] : S ⊧ T.mlift ↔ S ⊧ T :=
⟨by { intros h p hp,
      have : S ⊧ p.mlift, from @h p.mlift (by simpa using hp),
      exact models_mlift.mp this },
 by { intros h p hp,
      rcases mem_mlift_iff.mp hp with ⟨q, hq, rfl⟩,
      exact models_mlift.mpr (h hq) }⟩

def consequence : preTheory L μ → formula L μ → Prop := semantics.consequence (Structure L)

infix ` ⊧₀ ` :55 := consequence

lemma consequence_def {T : preTheory L μ} {p : formula L μ} :
  T ⊧₀ p ↔ (∀ S : Structure L, S ⊧ T → S ⊧ p) := by refl

end Structure

namespace nonempty_Structure
open bounded_preTheory
variables {M : nonempty_Structure L} {σ τ : sentence L} {m : ℕ} {T : bounded_preTheory L m}

@[simp] lemma models_Theory_mlift : M ⊧ T.mlift ↔ M ⊧ T :=
by simp[←coe_models_Theory_iff]

instance : has_double_turnstile (preTheory L μ) (formula L μ) := ⟨semantics.consequence (nonempty_Structure L)⟩

lemma consequence_def {T : preTheory L μ} {p : formula L μ} :
  T ⊧ p ↔ (∀ M : nonempty_Structure L, M ⊧ T → M ⊧ p) := by refl

end nonempty_Structure

variables {S : Structure L}
open subformula

theorem soundness {m} {T : bounded_preTheory L m} {p} : T ⊢ p → T ⊧₀ p :=
begin
  intros h,
  apply provable.rec_on h,
  { intros m T p b IH S hT Φ,
    simp[subformula.val], intros x,
    haveI : inhabited S, from ⟨x⟩,
    have : S ⊧ p, from @IH S (by simpa using hT),
    exact this (Φ <* x) },
  { intros m T p q b₁ b₂ m₁ m₂ S hT Φ,
    have h₁ : S ⊧[Φ] p → S ⊧[Φ] q, by simpa using m₁ hT Φ,
    have h₂ : S ⊧[Φ] p, from m₂ hT Φ,
    exact h₁ h₂ },
  { intros m T p hp S hS, exact hS hp },
  { intros m T S h Φ, simp },
  { intros m T p q S hS Φ, simp, intros h _, exact h },
  { intros m T p q r S hS Φ, simp,  intros h₁ h₂ h₃, exact h₁ h₃ (h₂ h₃) },
  { intros m T p q S hS Φ, simp, intros h₁, contrapose, exact h₁ },
  { intros m T p t S hS Φ, simp, intros h, exact h _ },
  { intros m T p q S hS Φ, simp, intros h₁ h₂ x, exact h₁ x h₂ }
end

instance {m} : logic.sound (bounded_formula L m) (Structure L) :=
⟨λ T p, soundness⟩

theorem nonempty_soundness {m} {T : bounded_preTheory L m} {p} : T ⊢ p → T ⊧ p :=
by intros h M hM; exact soundness h hM

instance {m} : logic.sound (bounded_formula L m) (nonempty_Structure L) :=
⟨λ T p, nonempty_soundness⟩

end fol


import .datatypes .additive .reconstruction_theorems tactic.norm_num
namespace polya

open expr tactic diseq_proof
--#check mk_nat_val_ne_proof use something like this below?
theorem fake_ne_zero_pf (q : ℚ) : q ≠ 0 := sorry
theorem fake_gt_zero_pf (q : ℚ) : q > 0 := sorry
theorem fake_lt_zero_pf (q : ℚ) : q < 0 := sorry
theorem fake_eq_zero_pf (q : ℚ) : q = 0 := sorry
theorem fake_ne_pf (q1 q2 : ℚ) : q1 ≠ q2 := sorry

private meta def solve_by_norm_num (e : expr) : tactic expr :=
do (_, pf) ← solve_aux e `[norm_num, tactic.done],
   return pf

meta def mk_ne_zero_pf (q : ℚ) : tactic expr :=
--do qe ← to_expr ``(%%(quote q) : ℚ),
--   to_expr ``(fake_ne_zero_pf (%%qe : ℚ))
--return `(fake_ne_zero_pf q)
solve_by_norm_num `(q ≠ 0)

-- proves that q > 0, q < 0, or q = 0
meta def mk_sign_pf (q : ℚ) : tactic expr :=
/-do qe ← to_expr `(%%(quote q) : ℚ),
   if q > 0 then to_expr `(fake_gt_zero_pf (%%qe : ℚ))
   else if q < 0 then to_expr `(fake_lt_zero_pf (%%qe : ℚ))
   else to_expr ``(fake_eq_zero_pf (%%qe : ℚ))-/
if q > 0 then --return `(fake_gt_zero_pf q)
  solve_by_norm_num `(q > 0)
else if q < 0 then --return `(fake_lt_zero_pf q)
  solve_by_norm_num `(q < 0)
else --return `(fake_eq_zero_pf q)
  solve_by_norm_num `(q = 0)

meta def mk_ne_pf (q1 q2 : ℚ) : tactic expr :=
/-do q1e ← to_expr ``(%%(quote q1) : ℚ),
   q2e ← to_expr ``(%%(quote q2) : ℚ),
   to_expr `(fake_ne_pf %%q1e %%q2e)-/
--return `(fake_ne_pf q1 q2)
solve_by_norm_num `(q1 ≠ q2)

meta def mk_int_sign_pf (z : ℤ) : tactic expr :=
if z > 0 then solve_by_norm_num `(z > 0) --return `(sorry : z > 0)
else if z < 0 then solve_by_norm_num `(z < 0)--return `(sorry : z < 0)
else solve_by_norm_num `(z = 0) --return `(sorry : z = 0)

-- proves z % 2 = 0 or z % 2 = 1
meta def mk_int_mod_pf (z : ℤ) : tactic expr :=
if z % 2 = 0 then return `(sorry : z % 2 = 0)
else return `(sorry : z % 2 = 1)

namespace diseq_proof
private meta def reconstruct_hyp (lhs rhs : expr) (c : ℚ) (pf : expr) : tactic expr :=
do mvc ← mk_mvar,
   pft ← infer_type pf,
   to_expr ``(%%lhs ≠ %%mvc * %%rhs) >>= unify pft,
   c' ← eval_expr rat mvc,
   if c = c' then return pf else fail "diseq_proof.reconstruct_hyp failed"

private meta def reconstruct_sym (rc : Π {lhs rhs : expr} {c : ℚ}, diseq_proof lhs rhs c → tactic expr)
        {lhs rhs c} (dp : diseq_proof lhs rhs c) : tactic expr :=
do symp ← rc dp,
   cnep ← mk_ne_zero_pf c,
   mk_mapp ``diseq_sym [none, none, none, cnep, symp] -- why doesn't mk_app work?

meta def reconstruct : Π {lhs rhs : expr} {c : ℚ}, diseq_proof lhs rhs c → tactic expr
| .(_) .(_) .(_) (hyp (lhs) (rhs) (c) e) := reconstruct_hyp lhs rhs c e
| .(_) .(_) .(_) (@sym lhs rhs c dp) := reconstruct_sym @reconstruct dp

end diseq_proof

namespace eq_proof

private meta def reconstruct_hyp (lhs rhs : expr) (c : ℚ) (pf : expr) : tactic expr :=
do mvc ← mk_mvar,
   pft ← infer_type pf,
   to_expr ``(%%lhs = %%mvc * %%rhs) >>= unify pft,
   c' ← eval_expr rat mvc,
   if c = c' then return pf else fail "eq_proof.reconstruct_hyp failed"

private meta def reconstruct_sym (rc : Π {lhs rhs : expr} {c : ℚ}, eq_proof lhs rhs c → tactic expr)
        {lhs rhs c} (dp : eq_proof lhs rhs c) : tactic expr :=
do symp ← rc dp,
   cnep ← mk_ne_zero_pf c, -- 5/1 ≠ 0
--   infer_type symp >>= trace,
--   infer_type cnep >>= trace,
   mk_mapp ``eq_sym [none, none, none, cnep, symp] -- why doesn't mk_app work?

variable iepr_fn : Π {lhs rhs i}, ineq_proof lhs rhs i → tactic expr

private meta def reconstruct_of_opp_ineqs_aux {lhs rhs i} (c : ℚ) (iep : ineq_proof lhs rhs i)
        (iepr : ineq_proof lhs rhs i.reverse) : tactic expr :=
do guard (bnot i.strict),
   pr1 ← iepr_fn iep, pr2 ← iepr_fn iepr,
   if i.to_comp.is_less then
     mk_mapp ``op_ineq [none, none, none, some pr1, some pr2]
   else
     mk_mapp ``op_ineq [none, none, none, some pr2, some pr1]

private theorem eq_sub_of_add_eq_facs {c1 c2 e1 e2 : ℚ} (hc1 : c1 ≠ 0) (h : c1 * e1 + c2 * e2 = 0) : e1 = -(c2/c1) * e2 :=
sorry

private meta def reconstruct_of_sum_form_proof (sfpr : Π {sf}, Π (sp : sum_form_proof sf), tactic expr) : expr → expr → ℚ → Π {sf},
       Π (sp : sum_form_proof ⟨sf, spec_comp.eq⟩), tactic expr | lhs rhs c sf sp :=
if lhs.lt rhs then -- flipped?
  reconstruct_of_sum_form_proof rhs lhs (1/c) sp
else do
  guard $ (sf.contains lhs) && (sf.contains rhs),
  let a := sf.get_coeff lhs in let b := sf.get_coeff rhs in do
  guard $ c = -(b/a),
  pf ← sfpr sp,
  nez ← mk_ne_zero_pf a,
  mk_app ``eq_sub_of_add_eq_facs [nez, pf]
--  fail "eq_proof.reconstruct_of_sum_proof not implemented yet"

meta def reconstruct_aux (sfpr : Π {sf}, Π (sp : sum_form_proof sf), tactic expr) : Π {lhs rhs : expr} {c : ℚ}, eq_proof lhs rhs c → tactic expr
| .(_) .(_) .(_) (hyp (lhs) (rhs) (c) e) := reconstruct_hyp lhs rhs c e
| .(_) .(_) .(_) (@sym lhs rhs c dp) := reconstruct_sym @reconstruct_aux dp
| .(_) .(_) .(_) (@of_opp_ineqs lhs rhs i c iep iepr) := reconstruct_of_opp_ineqs_aux @iepr_fn c iep iepr
| .(_) .(_) .(_) (@of_sum_form_proof lhs rhs c _ sp) := reconstruct_of_sum_form_proof @sfpr lhs rhs c sp
| .(_) .(_) .(_) (adhoc _ _ _ _ t) := t

end eq_proof

namespace ineq_proof

meta def guard_is_ineq (lhs rhs : expr) (iq : ineq) (pf : expr) : tactic expr :=
do mvc ← mk_mvar, pft ← infer_type pf,
match iq.to_comp with
| comp.lt := to_expr ``(%%lhs < %%mvc * %%rhs) >>= unify pft >> return mvc
| comp.le := to_expr ``(%%lhs ≤ %%mvc * %%rhs) >>= unify pft >> return mvc
| comp.gt := to_expr ``(%%lhs > %%mvc * %%rhs) >>= unify pft >> return mvc
| comp.ge := to_expr ``(%%lhs ≥ %%mvc * %%rhs) >>= unify pft >> return mvc
end

private meta def reconstruct_hyp (lhs rhs : expr) (iq : ineq) (pf : expr) : tactic expr :=
match iq.to_slope with
| slope.horiz  :=
  do tp ← infer_type pf, --trace "unifying tp in reconstruct_hyp1", trace tp,
     to_expr ``( %%(iq.to_comp.to_pexpr) %%rhs 0) >>= unify tp,
     return pf
| slope.some c :=
  do m ← guard_is_ineq lhs rhs iq pf,
     m' ← eval_expr rat m,
     if m' = c then return pf else fail "ineq_proof.reconstruct_hyp failed"
end

section
variable (rc : Π {lhs rhs : expr} {iq : ineq}, ineq_proof lhs rhs iq → tactic expr)
include rc

private meta def reconstruct_sym
        {lhs rhs iq} (ip : ineq_proof lhs rhs iq) : tactic expr :=
match iq.to_slope with
| slope.horiz  := do p ← pp (lhs, rhs), fail $ "reconstruct_sym failed on horiz slope: " ++ p.to_string
| slope.some m :=
  do --trace "in reconstruct sym", trace (lhs, rhs, m),
     symp ← rc ip, sgnp ← mk_sign_pf m, --trace "have proof of:", infer_type symp >>= trace,
--trace ("m", m), trace ("lhs, rhs", lhs, rhs), trace "sgnp", infer_type sgnp >>= trace, trace "symp", trace ip, infer_type symp >>= trace,
     --mk_mapp (name_of_c_and_comp m iq.to_comp) [none, none, none, some sgnp, some symp]
     mk_app (if m < 0 then ``sym_op_neg else ``sym_op_pos) [sgnp, symp]
end

-- x ≥ 2y and x ≠ 2y implies x > 2y
private meta def reconstruct_ineq_diseq {lhs rhs iq c} (ip : ineq_proof lhs rhs iq) (dp : diseq_proof lhs rhs c) : tactic expr :=
match iq.to_slope with
| slope.horiz := fail "reconstruct_ineq_diseq needs non-horiz slope"
| slope.some m :=
 if bnot (m=c) then
   fail "reconstruct_ineq_diseq found non-matching slopes"
 else if iq.strict then rc ip
 else do ipp ← rc ip, dpp ← dp.reconstruct,
 /-if iq.to_comp.is_less then
  mk_mapp ``ineq_diseq_le [none, none, none, some dpp, some ipp]
 else
  mk_mapp ``ineq_diseq_ge [none, none, none, some dpp, some ipp]-/
 mk_app ``ineq_diseq [dpp, ipp]
end

variable (rcs : Π {e gc}, sign_proof e gc → tactic expr)
include rcs

-- x ≤ 0y and x ≠ 0 implies x < 0y
private meta def reconstruct_ineq_sign_lhs {lhs rhs iq c} (ip : ineq_proof lhs rhs iq) (sp : sign_proof lhs c) : tactic expr :=
if iq.strict || bnot (c = gen_comp.ne) then fail "reconstruct_ineq_sign_lhs assumes a weak ineq and a diseq-0" else
match iq.to_slope with
| slope.horiz := fail "reconstruct_ineq_sign_lhs assumes a 0 slope"
| slope.some m :=
  if m = 0 then do
    ipp ← rc ip, spp ← rcs sp,
--    mk_app (if iq.to_comp.is_less then ``ineq_diseq_sign_lhs_le else ``ineq_diseq_sign_lhs_ge) [spp, ipp]
    mk_app ``ineq_diseq_sign_lhs [spp, ipp]
  else fail "reconstruct_ineq_sign_lhs assumes a 0 slope"
end

-- this might be wrong: should we produce proofs of y < 0?
private meta def reconstruct_ineq_sign_rhs {lhs rhs iq c} (ip : ineq_proof lhs rhs iq) (sp : sign_proof rhs c) : tactic expr :=
if iq.strict || bnot (c = gen_comp.ne) then fail "reconstruct_ineq_sign_rhs assumes a weak ineq and a diseq-0" else
match iq.to_slope with
| slope.horiz := do ipp ← rc ip, spp ← rcs sp,
--    mk_app (if iq.to_comp.is_less then ``ineq_diseq_sign_rhs_le else ``ineq_diseq_sign_rhs_ge) [spp, ipp]
    mk_app ``ineq_diseq_sign_rhs [spp, ipp]
| _ := fail "reconstruct_ineq_sign_rhs assumes a horizontal slope"
end

omit rc

-- x ≥ 0 implies x ≥ 0*y
private meta def reconstruct_zero_comp_of_sign {lhs c} (rhs : expr) (iq : ineq) (sp : sign_proof lhs c) : tactic expr :=
if bnot ((iq.to_comp.to_gen_comp = c) && (iq.is_zero_slope)) then fail $ "reconstruct_zero_comp_of_sign only produces comps with zero" ++ (to_fmt iq).to_string ++ (to_fmt iq.to_comp.to_gen_comp).to_string ++ (to_fmt c).to_string
--else do spp ← rcs sp, mk_app (zero_mul_name_of_comp iq.to_comp) [rhs, spp]
else do spp ← rcs sp, mk_mapp ``op_zero_mul [none, some rhs, none, none, some spp]

private meta def reconstruct_horiz_of_sign {rhs c} (lhs : expr) (iq : ineq) (sp : sign_proof rhs c) : tactic expr :=
if bnot ((iq.to_comp.to_gen_comp = c) && (iq.is_horiz)) then fail $ "reconstruct_horiz_of_sign failed"
else rcs sp

end

/-
private theorem eq_sub_of_add_eq_facs {c1 c2 e1 e2 : ℚ} (hc1 : c1 ≠ 0) (h : c1 * e1 + c2 * e2 = 0) : e1 = -(c2/c1) * e2 :=
sorry

private meta def reconstruct_of_sum_form_proof (sfpr : Π {sf}, Π (sp : sum_form_proof sf), tactic expr) : expr → expr → ℚ → Π {sf},
       Π (sp : sum_form_proof ⟨sf, spec_comp.eq⟩), tactic expr | lhs rhs c sf sp :=
if rhs.lt lhs then
  reconstruct_of_sum_form_proof rhs lhs (1/c) sp
else do
  guard $ (sf.contains lhs) && (sf.contains rhs),
  let a := sf.get_coeff lhs in let b := sf.get_coeff rhs in do
  guard $ c = -(b/a),
  pf ← sfpr sp,
  nez ← mk_ne_zero_pf a,
  mk_app ``eq_sub_of_add_eq_facs [nez, pf]
-/

private meta def reconstruct_of_sum_form_proof  (sfpr : Π {sf}, Π (sp : sum_form_proof sf), tactic expr) :
        expr → expr → ineq → Π {sfc}, sum_form_proof sfc → tactic expr | lhs rhs i sfc sp :=
if lhs.lt rhs then -- flipped?
  reconstruct_of_sum_form_proof rhs lhs i.reverse sp
else
 (match i.to_slope with
| slope.some m := do {
  guard $ (sfc.sf.contains lhs) && (sfc.sf.contains rhs),
  guard $ sfc.sf.keys.length = 2,
  let a := sfc.sf.get_coeff lhs in let b := sfc.sf.get_coeff rhs in do
  guard $ m = -(b/a),
  guard $ if a < 0 then sfc.c.to_comp = i.to_comp.reverse else sfc.c.to_comp = i.to_comp,
  rhs' ← to_expr ``(%%(↑(rat.reflect m) : expr) * %%rhs), -- better way to do this?
  tp ← i.to_comp.to_function lhs rhs',
  sgnp ← mk_sign_pf a,
  pf ← sfpr sp,
  --trace "have: ", infer_type pf >>= trace, trace ("lhs: ", lhs), trace ("rhs: ", rhs),
  let thnm := if a < 0 then ``op_of_sum_op_zero_neg else ``op_of_sum_op_zero_pos in
  mk_app thnm [pf, sgnp]}
  --to_expr ``(sorry : %%tp)
--  fail "ineq_proof.reconstruct_of_sum_proof not implemented yet"
| slope.horiz := fail "ineq_proof.reconstruct_of_sum_proof failed, cannot turn a sum into a horiz slope"
end)

meta def reconstruct_aux (rcs : Π {e gc}, sign_proof e gc → tactic expr) (sfpr : Π {sf}, Π (sp : sum_form_proof sf), tactic expr) :
     Π {lhs rhs : expr} {iq : ineq}, ineq_proof lhs rhs iq → tactic expr
| _ _ _ (hyp lhs rhs iq e) := reconstruct_hyp lhs rhs iq e
| _ _ _ (sym ip) := reconstruct_sym @reconstruct_aux ip
| _ _ _ (of_ineq_proof_and_diseq ip dp) := reconstruct_ineq_diseq @reconstruct_aux ip dp
| _ _ _ (of_ineq_proof_and_sign_lhs ip sp) := reconstruct_ineq_sign_lhs @reconstruct_aux @rcs ip sp
| _ _ _ (of_ineq_proof_and_sign_rhs ip sp) := reconstruct_ineq_sign_rhs @reconstruct_aux @rcs ip sp
| _ _ _ (zero_comp_of_sign_proof rhs iq sp) := reconstruct_zero_comp_of_sign @rcs rhs iq sp
| _ _ _ (horiz_of_sign_proof lhs iq sp) := reconstruct_horiz_of_sign @rcs lhs iq sp
| _ _ _ (of_sum_form_proof lhs rhs i sp) := reconstruct_of_sum_form_proof @sfpr lhs rhs i sp
| _ _ _ (adhoc _ _ _ _ t) := t

end ineq_proof

namespace sign_proof

private meta def reconstruct_hyp (e : expr) (gc : gen_comp) (pf : expr) : tactic expr :=
let pex := match gc with
| gen_comp.ge := ``(%%e ≥ 0)
| gen_comp.gt := ``(%%e > 0)
| gen_comp.le := ``(%%e ≤ 0)
| gen_comp.lt := ``(%%e < 0)
| gen_comp.eq := ``(%%e = 0)
| gen_comp.ne := ``(%%e ≠ 0)
end in do tp ← infer_type pf, to_expr pex >>= unify tp >> return pf

private meta def reconstruct_scaled_hyp (e : expr) (gc : gen_comp) (pf : expr) (q : ℚ) : tactic expr :=
do sp ← mk_sign_pf q,
   if q > 0 then
    mk_mapp ``op_zero_of_mul_op_zero_of_pos [none, none, none, none, pf, sp]
   else
    mk_mapp ``op_zero_of_mul_op_zero_of_neg [none, none, none, none, pf, sp]

section
parameter rc : Π {e c}, sign_proof e c → tactic expr
parameter sfpr : Π {sf}, Π (sp : sum_form_proof sf), tactic expr
private meta def rci := @ineq_proof.reconstruct_aux @rc @sfpr
private meta def rce := @eq_proof.reconstruct_aux @rci @sfpr

-- x ≤ 0*y to x ≤ 0
private meta def reconstruct_ineq_lhs (c : gen_comp) {lhs rhs iqp} (ip : ineq_proof lhs rhs iqp) : tactic expr :=
if bnot ((iqp.to_comp.to_gen_comp = c) && (iqp.is_zero_slope)) then fail "reconstruct_ineq_lhs must take a comparison with 0"
--else do ipp ← rci ip, mk_app (zero_mul'_name_of_comp iqp.to_comp) [ipp]
else do ipp ← rci ip, mk_app ``op_zero_mul' [ipp]

private meta def reconstruct_ineq_rhs (c : gen_comp) {lhs rhs iqp} (ip : ineq_proof lhs rhs iqp) : tactic expr :=
if bnot ((iqp.to_comp.to_gen_comp = c) && (iqp.is_horiz)) then fail "reconstruct_ineq_rhs must take a horiz comp"
else rci ip

private meta def reconstruct_eq_of_two_eqs_lhs {lhs rhs eqp1 eqp2} (ep1 : eq_proof lhs rhs eqp1) (ep2 : eq_proof lhs rhs eqp2) : tactic expr :=
if h : eqp1 = eqp2 then fail "reconstruct_eq_of_two_eqs lhs cannot infer anything from the same equality twice"
else do epp1 ← rce ep1, epp2 ← rce ep2, nep ← mk_ne_pf eqp1 eqp2,
        mk_app ``eq_zero_of_two_eqs_lhs [epp1, epp2, nep]

private meta def reconstruct_eq_of_two_eqs_rhs {lhs rhs eqp1 eqp2} (ep1 : eq_proof lhs rhs eqp1) (ep2 : eq_proof lhs rhs eqp2) : tactic expr :=
if h : eqp1 = eqp2 then fail "reconstruct_eq_of_two_eqs lhs cannot infer anything from the same equality twice"
else do epp1 ← rce ep1, epp2 ← rce ep2, nep ← mk_ne_pf eqp1 eqp2,
        mk_app ``eq_zero_of_two_eqs_rhs [epp1, epp2, nep]

private meta def reconstruct_diseq_of_diseq_zero {lhs rhs} (dp : diseq_proof lhs rhs 0) : tactic expr :=
do dpp ← dp.reconstruct,
   mk_app ``ne_zero_of_ne_mul_zero [dpp]

private meta def reconstruct_eq_of_eq_zero {lhs rhs} (ep : eq_proof lhs rhs 0) : tactic expr :=
do epp ← rce ep,
   mk_app ``eq_zero_of_eq_mul_zero [epp]

/-
private meta def reconstruct_ineqs (rct : contrad → tactic expr) {lhs rhs} (ii : ineq_info lhs rhs) (id : ineq_data lhs rhs) : tactic expr := do trace "ineqs!!",
match ii with
| ineq_info.no_comps := fail "reconstruct_ineqs cannot find a contradiction with no known comps"
| ineq_info.one_comp id2 := reconstruct_two_ineq_data rct id id2
| ineq_info.equal ed := reconstruct_eq_ineq ed id
| ineq_info.two_comps id1 id2 :=
   let sfid  := sum_form_comp_data.of_ineq_data id,
       sfid1 := sum_form_comp_data.of_ineq_data id1,
       sfid2 := sum_form_comp_data.of_ineq_data id2 in
   match find_contrad_in_sfcd_list [sfid, sfid1, sfid2] with
   | some ctr    := rct ctr
   | option.none := fail "reconstruct_ineqs failed to find contr"
   end
end
-/

private theorem {u} ge_of_not_lt {α : Type u} [linear_order α] {a b : α} (h : ¬ a < b) : (a ≥ b) := le_of_not_gt h

private theorem {u} gt_of_not_le {α : Type u} [linear_order α] {a b : α} (h : ¬ a ≤ b) : (a > b) := lt_of_not_ge h

private meta def neg_op_lemma_name : comp → name
| comp.lt := ``lt_of_not_ge
| comp.le := ``le_of_not_gt
| comp.ge := ``ge_of_not_lt
| comp.gt := ``gt_of_not_le

meta def reconstruct_ineq_of_eq_and_ineq_aux
-- (sfpr : Π {sf : sum_form_comp}, Π (sp : sum_form_proof sf), tactic.{0} (expr tt))
 {lhs rhs iq c} (c' : gen_comp) (ep : eq_proof lhs rhs c) (ip : ineq_proof lhs rhs iq) (pvt : expr) : tactic expr :=
do negt ← c'.to_comp.to_function pvt `(0 : ℚ),
   (_, notpf) ← solve_aux negt (do
     applyc $ neg_op_lemma_name c'.to_comp,
     hypv ← intro `h,
     let sfid := sum_form_comp_data.of_ineq_data ⟨_, ip⟩ in
     let sfed := sum_form_comp_data.of_eq_data ⟨_, ep⟩ in
     let sfsd := sum_form_comp_data.of_sign_data ⟨c'.negate, hyp pvt _ hypv⟩ in
     match find_contrad_sfcd_in_sfcd_list [sfid, sfed, sfsd] with
     | none := fail "reconstruct_ineq_of_eq_and_ineq failed to find proof"
     | some ⟨_, sfp, _⟩ := do ctrp ← sfpr sfp, fp ← mk_mapp ``lt_irrefl [none, none, none, ctrp], apply fp
--applyc ``lt_irrefl, trace "apply3", apply ctrp, trace "apply4"
     end),
   return notpf

--#check @reconstruct_ineq_of_eq_and_ineq_aux
-- these are the hard cases. Is this the right place to handle them?
private meta def reconstruct_ineq_of_eq_and_ineq_lhs {lhs rhs iq c} (c' : gen_comp) (ep : eq_proof lhs rhs c) (ip : ineq_proof lhs rhs iq) : tactic expr :=
reconstruct_ineq_of_eq_and_ineq_aux c' ep ip lhs
--fail "reconstruct_ineq_of_eq_and_ineq not implemented"

private meta def reconstruct_ineq_of_eq_and_ineq_rhs {lhs rhs iq c} (c' : gen_comp) (ep : eq_proof lhs rhs c) (ip : ineq_proof lhs rhs iq) : tactic expr :=
reconstruct_ineq_of_eq_and_ineq_aux c' ep ip rhs
/-do negt ← c'.to_comp.to_function rhs `(0 : ℚ),
   (_, notpf) ← solve_aux negt (do
     applyc $ neg_op_lemma_name c'.to_comp,
     hypv ← intro `h,
     let sfid := sum_form_comp_data.of_ineq_data ⟨_, ip⟩ in
     let sfed := sum_form_comp_data.of_eq_data ⟨_, ep⟩ in
     let sfsd := sum_form_comp_data.of_sign_data ⟨c', hyp rhs _ hypv⟩ in
     match find_contrad_sfcd_in_sfcd_list [sfid, sfed, sfsd] with
     | none := fail "reconstruct_ineq_of_eq_and_ineq_rhs failed to find proof"
     | some ⟨_, sfp, _⟩ := do ctrp ← sfpr sfp, applyc ``lt_irrefl, apply ctrp
     end),
   return notpf-/
--   fail "reconstruct_ineq_of_eq_and_ineq not implemented"

-- TODO
private meta def reconstruct_ineq_of_ineq_and_eq_zero_rhs {lhs rhs iq} (c : gen_comp) (ip : ineq_proof lhs rhs iq) (sp : sign_proof lhs gen_comp.eq) : tactic expr :=
fail "reconstruct_ineq_of_ineq_and_eq_zero not implemented"

private meta def reconstruct_diseq_of_strict_ineq {e c} (sp : sign_proof e c) : tactic expr :=
if c.is_strict then do
  spp ← rc sp,
  mk_app ``ne_of_strict_op [spp]
else fail "reconstruct_diseq_of_strict_ineq failed, comp is not strict"

end

-- TODO
private meta def reconstruct_of_sum_form_proof (sfpr : Π {sf}, Π (sp : sum_form_proof sf), tactic expr) (e : expr) (c : gen_comp) {sfc}
        (sp : sum_form_proof sfc) : tactic expr :=
do
   pf' ← sfpr sp,
   --trace "in sign_proof.reconstruct_of_sum_form_proof",
   --infer_type e >>= trace,
   --trace c,
   let coeff := sfc.sf.get_coeff e,
   if coeff = 0 then fail "sign_proof.reconstruct_of_sum_form_proof failed, zero coeff" else do
   coeff_sign_pr ← mk_sign_pf coeff,
--   if coeff < 0 then
     mk_mapp (if coeff < 0 then ``rev_op_zero_of_neg_mul_op_zero else ``op_zero_of_pos_mul_op_zero) [none, none, none, none, coeff_sign_pr, pf']
 --  else if coeff > 0 then
 --    mk_mapp ``op_zero_of_pos_mul_op_zero [none, none, none, none, coeff_sign_]
 --  fail "sign_proof.reconstruct_of_sum_form_proof failed, not implemented yet"

meta def reconstruct_eq_of_le_of_ge (rct : Π {e c}, sign_proof e c → tactic expr) {e} (lep : sign_proof e gen_comp.le) (gep : sign_proof e gen_comp.ge) : tactic expr :=
do lep' ← rct lep, gep' ← rct gep,
   mk_app ``le_antisymm' [lep', gep']

meta def reconstruct_aux (sfpr : Π {sf}, Π (sp : sum_form_proof sf), tactic expr) : Π {e c}, sign_proof e c → tactic expr
| .(_) .(_) (hyp e c pf) := reconstruct_hyp e c pf
| .(_) .(_) (scaled_hyp e c pf q) := reconstruct_scaled_hyp e c pf q
| .(_) .(_) (@ineq_lhs c _ _ _ ip) := reconstruct_ineq_lhs @reconstruct_aux @sfpr c ip
| .(_) .(_) (@ineq_rhs c _ _ _ ip) := reconstruct_ineq_rhs @reconstruct_aux @sfpr c ip
| .(_) .(_) (@eq_of_two_eqs_lhs _ _ _ _ ep1 ep2) := reconstruct_eq_of_two_eqs_lhs @reconstruct_aux @sfpr ep1 ep2
| .(_) .(_) (@eq_of_two_eqs_rhs _ _ _ _ ep1 ep2) := reconstruct_eq_of_two_eqs_rhs @reconstruct_aux @sfpr ep1 ep2
| .(_) .(_) (@diseq_of_diseq_zero _ _ dp) := reconstruct_diseq_of_diseq_zero dp
| .(_) .(_) (@eq_of_eq_zero _ _ ep) := reconstruct_eq_of_eq_zero @reconstruct_aux @sfpr ep
| .(_) .(_) (eq_of_le_of_ge lep gep) := reconstruct_eq_of_le_of_ge @reconstruct_aux lep gep
| .(_) .(_) (@ineq_of_eq_and_ineq_lhs _ _ _ _ c' ep ip) := reconstruct_ineq_of_eq_and_ineq_lhs @sfpr c' ep ip
| .(_) .(_) (@ineq_of_eq_and_ineq_rhs _ _ _ _ c' ep ip) := reconstruct_ineq_of_eq_and_ineq_rhs @sfpr c' ep ip
| .(_) .(_) (@ineq_of_ineq_and_eq_zero_rhs _ _ _ c ip sp) := reconstruct_ineq_of_ineq_and_eq_zero_rhs c ip sp
| .(_) .(_) (@diseq_of_strict_ineq _ _ sp) := reconstruct_diseq_of_strict_ineq @reconstruct_aux sp
| .(_) .(_) (@of_sum_form_proof e c _ sp) := reconstruct_of_sum_form_proof @sfpr e c sp
| .(_) .(_) (adhoc _ _ _ t) := t

end sign_proof

namespace sum_form_proof
section
parameter sfrc : Π {sfc}, sum_form_proof sfc → tactic expr
private meta def sprc := @sign_proof.reconstruct_aux @sfrc
private meta def iprc := @ineq_proof.reconstruct_aux @sprc @sfrc
private meta def eprc := @eq_proof.reconstruct_aux @iprc @sfrc

-- assumes lhs < rhs
private meta def reconstruct_of_ineq_proof  :
        Π {lhs rhs iq}, ineq_proof lhs rhs iq → tactic expr | lhs rhs iq ip :=
if expr.lt lhs rhs then reconstruct_of_ineq_proof ip.sym else
--trace "ipp is:" >> iprc ip >>= infer_type >>= trace >> trace "const is:" >> infer_type ↑`(@polya.mul_lt_of_lt) >>= trace >>
match iq.to_slope with
| slope.horiz :=
  do ipp ← iprc ip,
     tactic.mk_mapp (sum_form_name_of_comp_single iq.to_comp) [none, none, ipp]
| slope.some m :=
  do ipp ← iprc ip,
--trace ("ipp", ip, ipp), infer_type ipp >>= trace, trace ("comp", iq.to_comp), trace ("iq", iq),
     if m = 0 then
       tactic.mk_mapp (sum_form_name_of_comp_single iq.to_comp) [none, none, ipp]
     else
       tactic.mk_mapp (sum_form_name_of_comp iq.to_comp) [none, none, none, ipp]
--     tactic.mk_mapp ((if m = 0 then sum_form_name_of_comp_single else sum_form_name_of_comp) iq.to_comp) [none, none, ipp]
end
--include sfrc

private meta def reconstruct_of_eq_proof  :
        Π {lhs rhs c}, eq_proof lhs rhs c → tactic expr | lhs rhs c ep :=
if expr.lt lhs rhs then reconstruct_of_eq_proof ep.sym else
do ipp ← eprc ep,
   mk_app ``sub_eq_zero_of_eq [ipp]
--fail "sum_form_proof.reconstruct_of_eq_proof not implemented yet"

private meta def reconstruct_of_sign_proof :
        Π {e c}, sign_proof e c → tactic expr | e c sp :=
if c.is_less then sprc sp
else do spp ← sprc sp,
  --trace "spp type is", infer_type spp >>= trace,
  mk_mapp ``rev_op_zero_of_op [none, none, none, some spp]
--fail "sum_form_proof.reconstruct_of_sign_proof not implemented yet"

--  sum_form_proof ⟨lhs.add_factor rhs m, spec_comp.strongest c1 c2⟩
-- wait for algebraic normalizer?
-- TODO
private theorem reconstruct_of_add_factor_aux (P : Prop) {Q R : Prop} (h : Q) (h2 : R) : P := sorry

private meta def reconstruct_of_add_factor_same_comp {lhs rhs c1 c2} (m : ℚ)
        (sfpl : sum_form_proof ⟨lhs, c1⟩) (sfpr : sum_form_proof ⟨rhs, c2⟩) : tactic expr :=
let sum := lhs + rhs.scale m in
do tp ← sum_form.to_expr sum,
   tp' ← (spec_comp.strongest c1 c2).to_comp.to_function tp `(0 : ℚ),
   pf1 ← sfrc sfpl, pf2 ← sfrc sfpr,
   mk_mapp ``reconstruct_of_add_factor_aux [some tp', none, none, some pf1, some pf2] --to_expr `(sorry : %%tp)
--fail "reconstruct_of_add_factor_same_comp failed, not implemented yet"

private theorem reconstruct_of_add_eq_factor_op_comp_aux  (P : Prop) {Q R : Prop} (h : Q) (h2 : R) : P := sorry

/-
m is negative
-/
private meta def reconstruct_of_add_eq_factor_op_comp {lhs rhs c1} (m : ℚ)
        (sfpl : sum_form_proof ⟨lhs, c1⟩) (sfpr : sum_form_proof ⟨rhs, spec_comp.eq⟩) : tactic expr :=
let sum := lhs + rhs.scale m in
do tp ← sum_form.to_expr sum,
   tp' ← c1.to_comp.to_function tp `(0 : ℚ),
   pf1 ← sfrc sfpl, pf2 ← sfrc sfpr,
   mk_mapp ``reconstruct_of_add_eq_factor_op_comp_aux [some tp', none, none, some pf1, some pf2]
--fail "reconstruct_of_add_eq_factor_op_comp not implemented yet"

private theorem reconstruct_of_scale_aux (P : Prop) {Q : Prop} (h : Q) : P := sorry

private meta def reconstruct_of_scale (rct : Π {sfc}, sum_form_proof sfc → tactic expr)
        {sfc} (m : ℚ) (sfp : sum_form_proof sfc) : tactic expr :=
do tp ← sum_form.to_expr (sfc.sf.scale m),
   tp' ← sfc.c.to_comp.to_function tp `(0 : ℚ),
   pf ← rct sfp,
   mk_mapp ``reconstruct_of_scale_aux [some tp', none, some pf] -- to_expr `(sorry : %%tp')

end

-- TODO (alg norm)
theorem reconstruct_of_expr_def_aux (P : Prop) : P := sorry

private meta def reconstruct_of_expr_def (e : expr) (sf : sum_form) : tactic expr :=
do tp ← sum_form.to_expr sf,
   tp' ← to_expr ``(%%tp = 0),
--   (_, pf) ← solve_aux tp' (simp >> done),
   mk_app ``reconstruct_of_expr_def_aux [tp']
--   instantiate_mvars pf
--fail "reconstruct_of_expr_def failed, not implemented yet"

meta def reconstruct : Π {sfc}, sum_form_proof sfc → tactic expr
| _ (of_ineq_proof ip) := reconstruct_of_ineq_proof @reconstruct ip
| _ (of_eq_proof ep) := reconstruct_of_eq_proof @reconstruct ep
| _ (of_sign_proof sp) := reconstruct_of_sign_proof @reconstruct sp
| _ (of_add_factor_same_comp m sfpl sfpr) :=
  reconstruct_of_add_factor_same_comp @reconstruct m sfpl sfpr
| _ (of_add_eq_factor_op_comp m sfpl sfpr) :=
  reconstruct_of_add_eq_factor_op_comp @reconstruct m sfpl sfpr
| _ (of_scale m sfp) := reconstruct_of_scale @reconstruct m sfp
| _ (of_expr_def e sf) := reconstruct_of_expr_def e sf
| _ (fake sd) := fail "cannot reconstruct a fake proof"

/-meta def reconstruct : Π {sfc}, sum_form_proof sfc → tactic expr | sfc sfp :=
if sfc.sf.keys.length = 0 then do
 ex ← sfc.c.to_comp.to_function ```(0 : ℚ) ```(0 : ℚ),
 to_expr `(sorry : %%ex) else
let sfcd : sum_form_comp_data := ⟨_, sfp, mk_rb_set⟩ in
match sfcd.to_ineq_data with
| option.some ⟨lhs, rhs, id⟩ := do ex ← ineq_data.to_expr id, to_expr `(sorry : %%ex)
| none := trace sfc >> fail "fake sum_form_proof.reconstruct failed, no ineq data"
end-/

end sum_form_proof

meta def sign_proof.reconstruct := @sign_proof.reconstruct_aux @sum_form_proof.reconstruct
meta def ineq_proof.reconstruct := @ineq_proof.reconstruct_aux @sign_proof.reconstruct @sum_form_proof.reconstruct
meta def eq_proof.reconstruct := @eq_proof.reconstruct_aux @ineq_proof.reconstruct @sum_form_proof.reconstruct

meta def ineq_data.to_expr {lhs rhs} (id : ineq_data lhs rhs) : tactic expr :=
match id.inq.to_slope with
| slope.horiz := id.inq.to_comp.to_function rhs `(0 : ℚ)
| slope.some m := if m = 0 then id.inq.to_comp.to_function lhs `(0 : ℚ)
                  else do rhs' ← to_expr ``(%%(m.reflect : expr)*%%rhs), id.inq.to_comp.to_function lhs rhs'
end

namespace contrad

private meta def reconstruct_eq_diseq {lhs rhs} (ed : eq_data lhs rhs) (dd : diseq_data lhs rhs) : tactic expr :=
if bnot (ed.c = dd.c) then fail "reconstruct_eq_diseq failed: given different coefficients"
else do ddp ← dd.prf.reconstruct, edp ← ed.prf.reconstruct, return $ ddp.app edp

private meta def reconstruct_two_ineq_data {lhs rhs} (rct : contrad → tactic expr) (id1 id2 : ineq_data lhs rhs) : tactic expr :=
let sfid1 := sum_form_comp_data.of_ineq_data id1,
    sfid2 := sum_form_comp_data.of_ineq_data id2 in
match find_contrad_in_sfcd_list [sfid1, sfid2] with
| some ctr    := rct ctr
| option.none := fail "reconstruct_two_ineq_data failed to find contr"
end

private meta def reconstruct_eq_ineq {lhs rhs} (ed : eq_data lhs rhs) (id : ineq_data lhs rhs) : tactic expr :=
fail "reconstruct_eq_ineq not implemented"

-- TODO: this is the hard part. Should this be refactored into smaller pieces?
private meta def reconstruct_ineqs (rct : contrad → tactic expr) {lhs rhs} (ii : ineq_info lhs rhs) (id : ineq_data lhs rhs) : tactic expr := --do trace "ineqs!!",
match ii with
| ineq_info.no_comps := fail "reconstruct_ineqs cannot find a contradiction with no known comps"
| ineq_info.one_comp id2 := reconstruct_two_ineq_data rct id id2
| ineq_info.equal ed := reconstruct_eq_ineq ed id
| ineq_info.two_comps id1 id2 :=
   let sfid  := sum_form_comp_data.of_ineq_data id,
       sfid1 := sum_form_comp_data.of_ineq_data id1,
       sfid2 := sum_form_comp_data.of_ineq_data id2 in
   match find_contrad_in_sfcd_list [sfid, sfid1, sfid2] with
   | some ctr    := rct ctr
   | option.none := fail "reconstruct_ineqs failed to find contr"
   end
end

private meta def reconstruct_sign_ne_eq {e} (nepr : sign_proof e gen_comp.ne) (eqpr : sign_proof e gen_comp.eq) : tactic expr :=
do neprp ← nepr.reconstruct, eqprp ← eqpr.reconstruct,
   return $ neprp.app eqprp

private meta def reconstruct_sign_le_gt {e} (lepr : sign_proof e gen_comp.le) (gtpr : sign_proof e gen_comp.gt) : tactic expr :=
do leprp ← lepr.reconstruct, gtprp ← gtpr.reconstruct,
   mk_app ``le_gt_contr [leprp, gtprp]

private meta def reconstruct_sign_ge_lt {e} (gepr : sign_proof e gen_comp.ge) (ltpr : sign_proof e gen_comp.lt) : tactic expr :=
do geprp ← gepr.reconstruct, ltprp ← ltpr.reconstruct,
   mk_app ``ge_lt_contr [geprp, ltprp]

private meta def reconstruct_sign_gt_lt {e} (gtpr : sign_proof e gen_comp.gt) (ltpr : sign_proof e gen_comp.lt) : tactic expr :=
do gtprp ← gtpr.reconstruct, ltprp ← ltpr.reconstruct,
   mk_app ``gt_lt_contr [gtprp, ltprp]

private meta def reconstruct_sign {e} : sign_data e → sign_data e → tactic expr
| ⟨gen_comp.ne, prf1⟩ ⟨gen_comp.eq, prf2⟩ := reconstruct_sign_ne_eq prf1 prf2
| ⟨gen_comp.eq, prf1⟩ ⟨gen_comp.ne, prf2⟩ := reconstruct_sign_ne_eq prf2 prf1
| ⟨gen_comp.le, prf1⟩ ⟨gen_comp.gt, prf2⟩ := reconstruct_sign_le_gt prf1 prf2
| ⟨gen_comp.gt, prf1⟩ ⟨gen_comp.le, prf2⟩ := reconstruct_sign_le_gt prf2 prf1
| ⟨gen_comp.lt, prf1⟩ ⟨gen_comp.ge, prf2⟩ := reconstruct_sign_ge_lt prf2 prf1
| ⟨gen_comp.ge, prf1⟩ ⟨gen_comp.lt, prf2⟩ := reconstruct_sign_ge_lt prf1 prf2
| ⟨gen_comp.gt, prf1⟩ ⟨gen_comp.lt, prf2⟩ := reconstruct_sign_gt_lt prf1 prf2
| ⟨gen_comp.lt, prf1⟩ ⟨gen_comp.gt, prf2⟩ := reconstruct_sign_gt_lt prf2 prf1
| s1 s2 := trace e >> trace s1.c >> trace s2.c >> fail "reconstruct_sign failed: given non-opposite comps"

private meta def reconstruct_strict_ineq_self {e} (id : ineq_data e e) : tactic expr :=
match id.inq.to_comp, id.inq.to_slope with
| comp.gt, slope.some m :=
  if bnot (m = 1) then fail "reconstruct_strict_ineq_self failed: given non-one slope"
  else do idp ← id.prf.reconstruct,
       mk_app ``gt_self_contr [idp]
| comp.lt, slope.some m :=
  if bnot (m = 1) then fail "reconstruct_strict_ineq_self failed: given non-one slope"
  else do idp ← id.prf.reconstruct,
       mk_app ``lt_self_contr [idp]
| _, _ := fail "reconstruct_strict_ineq_self failed: given non-strict comp or non-one slope"
end

meta def reconstruct_sum_form {sfc} (sfp : sum_form_proof sfc) : tactic expr :=
if sfc.is_contr then do
  zltz ← sfp.reconstruct,
  mk_mapp ``lt_irrefl [option.none, option.none, option.none, some zltz]
else fail "reconstruct_sum_form requires proof of 0 < 0"

meta def reconstruct : contrad → tactic expr
| none := fail "cannot reconstruct contr: no contradiction is known"
| (@eq_diseq lhs rhs ed dd) := reconstruct_eq_diseq ed dd
| (@ineqs lhs rhs ii id) := reconstruct_ineqs reconstruct ii id
| (@sign e sd1 sd2) := reconstruct_sign sd1 sd2
| (@strict_ineq_self e id) := reconstruct_strict_ineq_self id
| (@sum_form _ sfp) := reconstruct_sum_form sfp

end contrad

namespace prod_form_proof

/-private meta def mk_prod_ne_zero_prf_aux : expr → list (Σ e : expr, sign_proof e gen_comp.ne) → tactic expr
| e [] := return e
| e (⟨e', sp⟩::t) := do ene ← sp.reconstruct, pf ← mk_app ``mul_ne_zero [e, ene], mk_prod_ne_zero_prf_aux pf t

private meta def mk_prod_ne_zero_prf (c : ℚ) : list (Σ e : expr, sign_proof e gen_comp.ne) → tactic expr
| [] := if c = 0 then fail "mk_prod_ne_zero_prf failed, c = 0" else mk_app ``fake_ne_zero_pf [`(c)]
| (⟨e, sp⟩::t) :=
  if c = 0 then fail "mk_prod_ne_zero_prf failed, c = 0" else
  do cprf ← mk_app ``fake_ne_zero_pf [`(c)],
     hpf ← sp.reconstruct,
     prodprf ← mk_prod_ne_zero_prf_aux hpf t,
     mk_app ``mul_ne_zero [hpf, prodprf]
-/
/-#check spec_comp_and_flipped_of_comp
-- not finished: need to orient c
private meta def reconstruct_of_ineq_proof_pos_lhs {lhs rhs iq} (id : ineq_proof lhs rhs iq)
        (sp : sign_proof lhs gen_comp.gt) (nzprs : hash_map expr (λ e, sign_proof e gen_comp.ne)) : tactic expr :=
match (spec_comp_and_flipped_of_comp iq.to_comp), iq.to_slope with
| _, slope.horiz := fail "reconstruct_of_ineq_proof_pos_lhs failed, cannot make a prod_form with 0 slope"
| (c, flipped), slope.some m :=
  if m = 0 then fail "reconstruct_of_ineq_proof_pos_lhs failed, cannot make a prod_form with 0 slope"
  else do -- lhs c m*rhs --> 1 c m*(lhs⁻¹*rhs)
     idp ← id.reconstruct,
     spp ← sp.reconstruct,
     opp ← mk_app ``one_op_inv_mul_of_op_of_pos [idp, spp], -- 1 r lhs⁻¹*rhs
     if bnot flipped then
        return opp
     else do
        mprf ← mk_sign_pf m,
        failed
end-/

private meta def reconstruct_of_ineq_proof_aux {lhs rhs iq c1 c2} (id : ineq_proof lhs rhs iq)
        (spl : sign_proof lhs c1) (spr : sign_proof rhs c2) (fail_cond : ℚ → bool)
        (unflipped_name flipped_name : name) --flipped_lt_name flipped_le_name : name)
       : tactic expr :=
match (spec_comp_and_flipped_of_comp iq.to_comp), iq.to_slope with
| _, slope.horiz := fail "reconstruct_of_ineq_proof_pos_pos failed, cannot make a prod_form with 0 slope"
| (c, flipped), slope.some m := --trace "okay, roipa" >> trace flipped >> trace iq >>
   if fail_cond m then fail "reconstruct_of_ineq_proof_aux failed check"
   else do
     idp ← id.reconstruct, --trace "idp_type:", infer_type idp >>= trace,
     splp ← spl.reconstruct, --trace "splp_type:", infer_type splp >>= trace, trace "c1 is:", trace c1, trace spl,
     opp ← mk_app unflipped_name [idp, splp],
     --trace "opp", infer_type opp >>= trace,
     if bnot flipped then return opp
     else do
        msgn ← mk_sign_pf m,
        sprp ← spr.reconstruct,
        trace "HERE", infer_type opp >>= trace, infer_type splp >>= trace, infer_type sprp >>= trace, infer_type msgn >>= trace, trace unflipped_name, trace iq,
        mk_app flipped_name-- (if c=spec_comp.lt then flipped_lt_name else flipped_le_name)
               [opp, splp, sprp, msgn]
end

private meta def reconstruct_of_ineq_proof_pos_pos {lhs rhs iq} (id : ineq_proof lhs rhs iq)
        (spl : sign_proof lhs gen_comp.gt) (spr : sign_proof rhs gen_comp.gt) : tactic expr :=
reconstruct_of_ineq_proof_aux id spl spr (λ m, m ≤ 0)
  ``one_op_inv_mul_of_op_of_pos ``one_op_inv_mul_of_lt_of_pos_pos_flipped' -- ``one_le_inv_mul_of_le_of_pos_pos_flipped
/-match (spec_comp_and_flipped_of_comp iq.to_comp), iq.to_slope with
| _, slope.horiz := fail "reconstruct_of_ineq_proof_pos_pos failed, cannot make a prod_form with 0 slope"
| (c, flipped), slope.some m :=
   if m ≤ 0 then fail "reconstruct_of_ineq_proof_pos_pos failed, m ≤ 0"
   else do
     idp ← id.reconstruct,
     splp ← spl.reconstruct,
     opp ← mk_app ``one_op_inv_mul_of_op_of_pos [idp, splp],
     if bnot flipped then return opp
     else do
        msgn ← mk_sign_pf m,
        sprp ← spr.reconstruct,
        mk_app (if c=spec_comp.lt then ``one_lt_inv_mul_of_lt_of_pos_flipped
                 else ``one_le_inv_mul_of_le_of_pos_flipped)
               [opp, splp, sprp, msgn]
end-/

private meta def reconstruct_of_ineq_proof_pos_neg {lhs rhs iq} (id : ineq_proof lhs rhs iq)
        (spl : sign_proof lhs gen_comp.gt) (spr : sign_proof rhs gen_comp.lt) : tactic expr :=
reconstruct_of_ineq_proof_aux id spl spr (λ m, m ≥ 0)
  ``one_op_inv_mul_of_op_of_pos ``one_op_inv_mul_of_lt_of_pos_neg_flipped -- ``one_le_inv_mul_of_le_of_pos_neg_flipped

private meta def reconstruct_of_ineq_proof_neg_pos {lhs rhs iq} (id : ineq_proof lhs rhs iq)
        (spl : sign_proof lhs gen_comp.lt) (spr : sign_proof rhs gen_comp.gt) : tactic expr :=
reconstruct_of_ineq_proof_aux id spl spr (λ m, m ≥ 0)
  ``one_op_inv_mul_of_op_of_neg ``one_op_inv_mul_of_lt_of_neg_pos_flipped -- ``one_le_inv_mul_of_le_of_neg_flipped

private meta def reconstruct_of_ineq_proof_neg_neg {lhs rhs iq} (id : ineq_proof lhs rhs iq)
        (spl : sign_proof lhs gen_comp.lt) (spr : sign_proof rhs gen_comp.lt) : tactic expr :=
reconstruct_of_ineq_proof_aux id spl spr (λ m, m ≤ 0)
  ``one_op_inv_mul_of_op_of_neg ``one_op_inv_mul_of_lt_of_neg_neg_flipped

/-
pos_neg
cmatch (spec_comp_and_flipped_of_comp iq.to_comp), iq.to_slope with
| _, slope.horiz := fail "reconstruct_of_ineq_proof_pos_pos failed, cannot make a prod_form with 0 slope"
| (c, flipped), slope.some m :=
   if m ≥ 0 then fail "reconstruct_of_ineq_proof_pos_neg failed, m ≥ 0"
   else do
     idp ← id.reconstruct,
     splp ← spl.reconstruct,
     opp ← mk_app ``one_op_inv_mul_of_op_of_pos [idp, splp],
     if bnot flipped then return opp
     else do
        msgn ← mk_sign_pf m,
        sprp ← spr.reconstruct,
        mk_app (if c=spec_comp.lt then ``one_lt_inv_mul_of_lt_of_pos_flipped
                 else ``one_le_inv_mul_of_le_of_pos_flipped)
               [opp, splp, sprp, msgn]
end -/

private meta def reconstruct_of_ineq_proof {lhs rhs iq} (id : ineq_proof lhs rhs iq) :
        Π {cl cr}, sign_proof lhs cl → sign_proof rhs cr → tactic expr
| gen_comp.gt gen_comp.gt spl spr := reconstruct_of_ineq_proof_pos_pos id spl spr
| gen_comp.gt gen_comp.lt spl spr := reconstruct_of_ineq_proof_pos_neg id spl spr
| gen_comp.lt gen_comp.gt spl spr := reconstruct_of_ineq_proof_neg_pos id spl spr
| gen_comp.lt gen_comp.lt spl spr := reconstruct_of_ineq_proof_neg_neg id spl spr
| _ _ _ _ := fail "reconstruct_of_ineq_proof failed, need to know signs of components"

/-
-- TODO
private meta def reconstruct_of_ineq_proof_neg_lhs {lhs rhs iq} (id : ineq_proof lhs rhs iq)
        (sp : sign_proof lhs gen_comp.lt) (nzprs : hash_map expr (λ e, sign_proof e gen_comp.ne)) : tactic expr :=
match iq.to_slope with
| slope.horiz := fail "reconstruct_of_ineq_proof_neg_lhs failed, cannot make a prod_form with 0 slope"
| slope.some m :=
  if m = 0 then fail "reconstruct_of_ineq_proof_pos_lhs failed, cannot make a prod_form with 0 slope"
  else
  failed
end-/

private meta def reconstruct_of_eq_proof {lhs rhs c} (id : eq_proof lhs rhs c)
        (lhsne : sign_proof lhs gen_comp.ne) : tactic expr :=
if c = 0 then fail "reconstruct_of_eq_proof failed, cannot make a prod_form with 0 slope"
else do
  lhsnep ← lhsne.reconstruct,
  idpf ← id.reconstruct,
  mk_app ``one_eq_div_of_eq [idpf, lhsnep]

theorem reconstruct_of_expr_def_aux (P : Prop) : P := sorry

/-

-- TODO

private meta def reconstruct_of_expr_def (e : expr) (sf : sum_form) : tactic expr :=
do tp ← sum_form.to_expr sf,
   tp' ← to_expr ``(%%tp = 0),
--   (_, pf) ← solve_aux tp' (simp >> done),
   mk_app ``reconstruct_of_expr_def_aux [tp']
--   instantiate_mvars pf
--fail "reconstruct_of_expr_def failed, not implemented yet"
-/

-- TODO (alg_nom)
private meta def reconstruct_of_expr_def (e : expr) (pf : prod_form) : tactic expr :=
do --trace "in reconstruct_of_expr_def",
   tp ← prod_form.to_expr pf,
 --  trace "tp:", trace tp,
   tp' ← to_expr ``(1 = %%tp),
 --  trace "tp':", trace tp',
--   (_, pf) ← solve_aux tp' (simp >> done),
   mk_app ``reconstruct_of_expr_def_aux [tp']

section
variable (rct : Π {pfc}, prod_form_proof pfc → tactic expr)

-- Given an expr of the form e := (p1^e1)^k, produces a proof that
-- e = p1^(e1*k)
private meta def simp_pow_aux_aux (p e k : expr) : tactic expr :=
mk_app ``rat.pow_pow [p, e, k]

/-private meta def simp_pow_aux_aux : expr → tactic expr
| `(rat.pow (rat.pow %%p %%e) %%k) := mk_app ``rat.pow_pow [p, e, k]
| _ := failed
-/

-- Given an expr of the form e := (p1^e1*...*pn^en)^k, produces a proof that
-- e = (p1^(e1*k) * ... * pn^(en*k)
private meta def simp_pow_aux : expr → tactic expr | e :=
match e with
| `(rat.pow (%%a * (rat.pow %%b %%n)) %%k) :=
  let prod' := `(rat.pow %%a %%k) in
  do prod_pf ← simp_pow_aux prod',
     pow_pf ← mk_app ``rat.mul_pow [a, `(rat.pow %%b %%n), k],
     one_pow_pf ← simp_pow_aux_aux b n k,
--     trace "doing rewrite",
--     infer_type pow_pf >>= trace, trace e,
     (e', pf1, []) ← rewrite pow_pf e,
     (e'', pf2, []) ← rewrite one_pow_pf e',
     (e''', pf3, []) ← rewrite prod_pf e'',
     t1 ← mk_app ``eq.trans [pf1, pf2],
     mk_app ``eq.trans [t1, pf3]
| `(rat.pow (rat.pow %%a %%n) %%k) :=
  simp_pow_aux_aux a n k
| e := do f ← pp e, fail $ "simp_pow_aux failed on " ++ f.to_string
end

-- Given an expr of the form e := (c*(p1^e1*...*pn^en))^k, produces a proof that
-- e = c^k * (p1^(e1*k) * ... * pn^(en*k))
meta def simp_pow (e : expr) :  tactic expr :=
--do trace "simp pow called on:", trace e,
match e with
| `(rat.pow (%%coeff * %%prod) %%k) :=
  let prod' := `(rat.pow %%prod %%k) in
  do prod_pf ← simp_pow_aux prod',
     pow_pf ← mk_app ``rat.mul_pow [coeff, prod, k],
     --trace "doing rewrite",
     (e', pf1, []) ← rewrite pow_pf e,
     (e'', pf2, []) ← rewrite prod_pf e',
     mk_app ``eq.trans [pf1, pf2]
| _ := fail "simp_pow got malformed arg"
end

/-example (a b c : ℚ) (m n k : ℤ) : rat.pow (a * (rat.pow b m * rat.pow c n)) k = rat.pow a k * (rat.pow b (m*k) * rat.pow c (n*k)) :=
by do
(lhs, rhs) ← target >>= match_eq,
e ← simp_pow lhs,
infer_type e >>= trace,
exact e-/

private meta def simp_pow_expr (pf tgt : expr) : tactic expr :=
do sls ← (simp_lemmas.mk.add_simp ``rat.mul_pow_rev) >>= λ t, t.add pf,
   --trace "target", trace tgt,
   --trace "pf tp", infer_type pf >>= trace,
   (do (_, npf) ← simplify sls [] tgt,-- <|> do rpr ← to_expr ``(eq.refl %%tgt), return (`(()), rpr),
   --(_, npf) ← solve_aux tgt (simp_target sls >> done),
   return npf) <|> to_expr ``(eq.refl %%tgt)

meta def simp_lemmas.add_simp_list : simp_lemmas → list name → tactic simp_lemmas
| s [] := return s
| s (h::t) := s.add_simp h >>= λ s', simp_lemmas.add_simp_list s' t

private meta def simp_pow_expr' (tgt : expr) : tactic expr :=
do --sls ← (simp_lemmas.mk.add_simp ``rat.mul_pow) >>= (λ s, simp_lemmas.add_simp s ``rat.pow_one) >>= (λ s, simp_lemmas.add_simp s ``rat.pow_neg_one),
   sls ← simp_lemmas.add_simp_list simp_lemmas.mk [``rat.mul_pow, ``rat.pow_one, ``rat.pow_neg_one, ``rat.one_pow, ``rat.pow_pow, ``rat.one_div_pow],
   --trace "target", trace tgt,
--   trace "pf tp", infer_type pf >>= trace,
--   (do (_, npf) ← simplify sls [] tgt,-- <|> do rpr ← to_expr ``(eq.refl %%tgt), return (`(()), rpr),
   (_, npf) ← solve_aux tgt ( /-trace_state >>-/ simp_target sls >>/- trace "!!!" >> trace_state >>-/ reflexivity), -- `[simp [rat.mul_pow_rev, rat.pow_one], done],
   return npf

section
open expr
private meta def reconstruct_of_pow_pos {pfc} (z : ℤ) (pfp : prod_form_proof pfc) : tactic expr :=
if z ≤ 0 then fail "reconstruct_of_pow_pos failed, given negative exponent" else
do zsn ← mk_int_sign_pf z,
   pf1 ← rct pfp,
   --trace "here", /-trace pfc,-/ trace pfp, trace z, infer_type pf1 >>= trace,
   pf2 ← mk_mapp (if pfc.c = spec_comp.lt then ``lt_pos_pow' else ``le_pos_pow') [none, pf1, none, zsn],
   --trace "pf2tp", infer_type pf2 >>= trace,
   pf2tp ← infer_type pf2,
   match pf2tp with
   | (app (app (app o i) lhs) rhs) :=
    do eqp ← simp_pow rhs,
       (new_type, prf, []) ← rewrite eqp pf2tp,
       mk_eq_mp prf pf2
--       failed
   | _ := fail "reconstruct_of_pow_pos failed"
   end
/-
   match pf2tp with
   | app (app (app o i) lhs) rhs := do tgt ← prod_form.to_expr (pfc.pf.pow z), pf ← to_expr ``(%%rhs = %%tgt) >>= simp_pow_expr',
    trace "pf2tp", trace pf2tp, trace "pftp", infer_type pf >>= trace,
    trace "o", trace o,
--    trace `(%%o %%lhs %%tgt),
    tgt' ← return $ app (app (app o i) lhs) tgt,--to_expr ``(%%o %%lhs %%tgt),
    trace "new tgt:", trace tgt',
    pf1 ← to_expr ``(eq.symm %%pf),
    (_, pf') ← solve_aux tgt' (rewrite_target pf1 >> apply pf2),
    trace "proved", infer_type pf' >>= trace,
    return pf'
   | _ := failed
   end
--   tgt ← prod_form.to_expr (pfc.pf.pow z),
--   simp_pow_expr pf2 tgt -/

end

/-private meta def reconstruct_of_pow_neg {pfc} (z : ℤ) (pfp : prod_form_proof pfc) : tactic expr :=
if z ≥ 0 then fail "reconstruct_of_pow_neg failed, given positive exponent" else
failed-/

private meta def reconstruct_of_pow_eq {pfc} (z : ℤ) (pfp : prod_form_proof pfc) : tactic expr :=
do --trace "pfp is:", trace pfp,
   pf1 ← rct pfp, --trace "reconstructed", infer_type pf1 >>= trace,
   tpf ← mk_app ``eq_pow [pf1, `(z)],
   tpf' ← mk_app ``eq_pow' [tpf],
   tpf_tp ← infer_type tpf',
   tgt ← prod_form.to_expr (pfc.pf.pow z),
   --trace "target is:", trace tgt,
   tgt' ← to_expr ``(1 = %%tgt),
   --trace "tgt', tpf", trace tgt', infer_type tpf >>= trace,
   (_, pf') ← solve_aux tgt' (assertv `h tpf_tp tpf' >> `[simp only [rat.mul_pow, rat.pow_pow], simp only [rat.mul_pow, rat.pow_pow] at h, apply h] >> done),
   return pf'
--   simp_pow_expr tpf tgt

private meta def reconstruct_of_pow {pfc} (z : ℤ) (pfp : prod_form_proof pfc) : tactic expr :=
if pfc.c = spec_comp.eq then reconstruct_of_pow_eq @rct z pfp else reconstruct_of_pow_pos @rct z pfp

private theorem reconstruct_of_mul_aux (P : Prop) {Q R : Prop} : Q → R → P := sorry

private meta def reconstruct_of_mul (rct : Π {pfc}, prod_form_proof pfc → tactic expr)
        {lhs rhs c1 c2} (pfp1 : prod_form_proof ⟨lhs, c1⟩) (pfp2 : prod_form_proof ⟨rhs, c2⟩)
        (sgns : list Σ e : expr, sign_proof e gen_comp.ne) : tactic expr :=
let prod := lhs * rhs in
do /-trace "in reconstruct_of_mul",
   trace prod,-/
   tp  ← prod_form.to_expr prod,
   --trace tp,
   tp' ← (spec_comp.strongest c1 c2).to_comp.to_function `(1 : ℚ) tp,
   --trace tp',
   pf1 ← rct pfp1, pf2 ← rct pfp2,-- trace "**",
   mk_mapp ``reconstruct_of_mul_aux [tp', none, none, pf1, pf2]
/-
let sum := lhs + rhs.scale m in
do tp ← sum_form.to_expr sum,
   tp' ← (spec_comp.strongest c1 c2).to_comp.to_function tp `(0 : ℚ),
   pf1 ← sfrc sfpl, pf2 ← sfrc sfpr,
   mk_mapp ``reconstruct_of_add_factor_aux [some tp', none, none, some pf1, some pf2]
-/

end

meta def reconstruct : Π {pfc}, prod_form_proof pfc → tactic expr
--| .(_) (@of_ineq_proof_pos_lhs _ _ _ id sp nzprs) := reconstruct_of_ineq_proof_pos_lhs id sp nzprs
--| .(_) (@of_ineq_proof_neg_lhs _ _ _ id sp nzprs) := reconstruct_of_ineq_proof_neg_lhs id sp nzprs
| .(_) (@of_ineq_proof _ _ _ _ _ id spl spr) := reconstruct_of_ineq_proof id spl spr
| .(_) (@of_eq_proof _ _ _ id lhsne) := reconstruct_of_eq_proof id lhsne
| .(_) (@of_expr_def e pf) := reconstruct_of_expr_def e pf
| .(_) (@of_pow _ z pfp) := reconstruct_of_pow @reconstruct z pfp
| .(_) (@of_mul _ _ _ _ pfp1 pfp2 sgns) := reconstruct_of_mul @reconstruct pfp1 pfp2 sgns
| .(_) (adhoc _ _ t) := t
| .(_) (fake _) := fail "prod_form_proof.reconstruct failed: cannot reconstruct fake"

end prod_form_proof

end polya


import Lean

example : True := by
  apply True.intro
      --^ textDocument/hover

example : True := by
  simp [True.intro]
      --^ textDocument/hover

example (n : Nat) : True := by
  match n with
  | Nat.zero => _
  --^ textDocument/hover
  | n + 1 => _

/-- My tactic -/
macro "mytac" o:"only"? e:term : tactic => `(tactic| exact $e)

example : True := by
  mytac only True.intro
--^ textDocument/hover
      --^ textDocument/hover
           --^ textDocument/hover

/-- My way better tactic -/
macro_rules
  | `(tactic| mytac $[only]? $e:term) =>
    --^ textDocument/hover
                              --^ textDocument/hover
    `(tactic| apply $e:term)
    --^ textDocument/hover
                      --^ textDocument/hover

example : True := by
  mytac only True.intro
--^ textDocument/hover

/-- My ultimate tactic -/
elab_rules : tactic
  | `(tactic| mytac $[only]? $e) => do Lean.Elab.Tactic.evalTactic (← `(tactic| refine $e))

example : True := by
  mytac only True.intro
--^ textDocument/hover

/-- My notation -/
macro (name := myNota) "mynota" e:term : term => pure e
              --^ textDocument/hover

#check mynota 1
     --^ textDocument/hover

/-- My way better notation -/
macro_rules
  | `(mynota $e) => `(2 * $e)

#check mynota 1
     --^ textDocument/hover

-- macro_rules take precedence over elab_rules for term/command, so use new syntax
syntax "mynota'" term : term

/-- My ultimate notation -/
elab_rules : term
  | `(mynota' $e) => `($e * $e) >>= (Lean.Elab.Term.elabTerm · none)

#check mynota' 1
     --^ textDocument/hover

@[inherit_doc]
infix:65 (name := myInfix) " >+< " => Nat.add
                   --^ textDocument/hover
                                     --^ textDocument/hover

#check 1 >+< 2
        --^ textDocument/hover

@[inherit_doc] notation "ℕ" => Nat

#check ℕ
     --^ textDocument/hover

/-- My command -/
macro "mycmd" e:term : command => do
  let seq ← `(Lean.Parser.Term.doSeq| $e:term)
            --^ textDocument/hover
  `(def hi := Id.run do $seq:doSeq)
                            --^ textDocument/hover

mycmd 1
--^ textDocument/hover

/-- My way better command -/
macro_rules
  | `(mycmd $e) => `(@[inline] def hi := $e)

mycmd 1
--^ textDocument/hover

syntax "mycmd'" ppSpace sepBy1(term, " + ") : command
              --^ textDocument/hover
                      --^ textDocument/hover
                             --^ textDocument/hover

/-- My ultimate command -/
elab_rules : command
  | `(mycmd' $e) => do Lean.Elab.Command.elabCommand (← `(/-- hi -/ @[inline] def hi := $e))

mycmd' 1
--^ textDocument/hover

#check ({ a := })  -- should not show `sorry`
        --^ textDocument/hover

example : True := by
  simp [id True.intro]
      --^ textDocument/hover
        --^ textDocument/hover

example : Id Nat := do
  let mut n := 1
  n := 2
--^ textDocument/hover
  n

opaque foo : Nat

#check _root_.foo
       --^ textDocument/hover

namespace Bar

opaque foo : Nat
     --^ textDocument/hover

#check _root_.foo
       --^ textDocument/hover

def bar := 1
  --^ textDocument/hover

structure Foo := mk ::
        --^ textDocument/hover
               --^ textDocument/hover
  hi : Nat
--^ textDocument/hover

inductive Bar
        --^ textDocument/hover
  | mk : Bar
  --^ textDocument/hover

instance : ToString Nat := ⟨toString⟩
--^ textDocument/hover
instance f : ToString Nat := ⟨toString⟩
       --^ textDocument/hover

example : Type 0 := Nat
        --^ textDocument/hover

def foo.bar : Nat := 1
  --^ textDocument/hover
      --^ textDocument/hover

example : Nat → Nat → Nat :=
  fun x y =>
    --^ textDocument/hover
  --v textDocument/definition
    x
  --^ textDocument/hover

           -- textDocument/definition -- removed because the result is platform-dependent
set_option linter.unusedVariables false in
          --^ textDocument/hover
example : Nat → Nat → Nat := by
  intro x y
      --^ textDocument/hover
      --v textDocument/definition
  exact x
      --^ textDocument/hover

def g (n : Nat) : Nat := g 0
termination_by g n => n
decreasing_by have n' := n; admit
                       --^ textDocument/hover

@[inline]
--^ textDocument/hover
def one := 1

example : True ∧ False := by
  constructor
  · constructor
--^ textDocument/hover

example : Nat := Id.run do (← 1)
                          --^ textDocument/hover

#check (· + ·)
      --^ textDocument/hover
        --^ textDocument/hover
macro "my_intro" x:(ident <|> "_") : tactic =>
  match x with
  | `($x:ident) => `(tactic| intro $x:ident)
  | _ => `(tactic| intro _%$x)

example : α → α := by intro x; assumption
                          --^ textDocument/hover
example : α → α := by intro _; assumption
                          --^ textDocument/hover
example : α → α := by my_intro x; assumption
                             --^ textDocument/hover
example : α → α := by my_intro _; assumption
                             --^ textDocument/hover

example : Nat → True := by
  intro x
      --^ textDocument/hover
  cases x with
  | zero => trivial
  --^ textDocument/hover
  --v textDocument/hover
  | succ x => trivial
       --^ textDocument/hover

example : Nat → True := by
  intro x
      --^ textDocument/hover
  induction x with
          --^ textDocument/hover
  | zero => trivial
  --^ textDocument/hover
       --v textDocument/hover
  | succ _ ih => exact ih
         --^ textDocument/hover

example : Nat → Nat
    --v textDocument/hover
  | .zero => .zero
             --^ textDocument/hover
    --v textDocument/hover
  | .succ x => .succ x
               --^ textDocument/hover

example : Inhabited Nat := ⟨Nat.zero⟩
                         --^ textDocument/hover
                          --^ textDocument/hover

example : Nat :=
  let x := match 0 with | _ => 0
  _
--^ textDocument/hover

def auto (o : Nat := by exact 1) : Nat := o
  --^ textDocument/hover


/-
Copyright (c) 2020 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Meta.Check
import Lean.Meta.Match.MatcherInfo
import Lean.Meta.Match.CaseArraySizes

namespace Lean.Meta.Match

inductive Pattern : Type where
  | inaccessible (e : Expr) : Pattern
  | var          (fvarId : FVarId) : Pattern
  | ctor         (ctorName : Name) (us : List Level) (params : List Expr) (fields : List Pattern) : Pattern
  | val          (e : Expr) : Pattern
  | arrayLit     (type : Expr) (xs : List Pattern) : Pattern
  | as           (varId : FVarId) (p : Pattern) (hId : FVarId) : Pattern
  deriving Inhabited

namespace Pattern

partial def toMessageData : Pattern → MessageData
  | inaccessible e         => m!".({e})"
  | var varId              => mkFVar varId
  | ctor ctorName _ _ []   => ctorName
  | ctor ctorName _ _ pats => m!"({ctorName}{pats.foldl (fun (msg : MessageData) pat => msg ++ " " ++ toMessageData pat) Format.nil})"
  | val e                  => e
  | arrayLit _ pats        => m!"#[{MessageData.joinSep (pats.map toMessageData) ", "}]"
  | as varId p h           => m!"{mkFVar varId}@{toMessageData p}"

partial def toExpr (p : Pattern) (annotate := false) : MetaM Expr :=
  visit p
where
  visit (p : Pattern) := do
    match p with
    | inaccessible e                 =>
      if annotate then
        pure (mkInaccessible e)
      else
        pure e
    | var fvarId                     => pure $ mkFVar fvarId
    | val e                          => pure e
    | as fvarId p hId                =>
      -- TODO
      if annotate then
        mkAppM ``namedPattern #[mkFVar fvarId, (← visit p), mkFVar hId]
      else
        visit p
    | arrayLit type xs               =>
      let xs ← xs.mapM visit
      mkArrayLit type xs
    | ctor ctorName us params fields =>
      let fields ← fields.mapM visit
      pure $ mkAppN (mkConst ctorName us) (params ++ fields).toArray

/- Apply the free variable substitution `s` to the given pattern -/
partial def applyFVarSubst (s : FVarSubst) : Pattern → Pattern
  | inaccessible e  => inaccessible $ s.apply e
  | ctor n us ps fs => ctor n us (ps.map s.apply) $ fs.map (applyFVarSubst s)
  | val e           => val $ s.apply e
  | arrayLit t xs   => arrayLit (s.apply t) $ xs.map (applyFVarSubst s)
  | var fvarId      => match s.find? fvarId with
    | some e => inaccessible e
    | none   => var fvarId
  | as fvarId p hId => match s.find? fvarId with
    | none   => as fvarId (applyFVarSubst s p) hId
    | some _ => applyFVarSubst s p

def replaceFVarId (fvarId : FVarId) (v : Expr) (p : Pattern) : Pattern :=
  let s : FVarSubst := {}
  p.applyFVarSubst (s.insert fvarId v)

partial def hasExprMVar : Pattern → Bool
  | inaccessible e => e.hasExprMVar
  | ctor _ _ ps fs => ps.any (·.hasExprMVar) || fs.any hasExprMVar
  | val e          => e.hasExprMVar
  | as _ p _       => hasExprMVar p
  | arrayLit t xs  => t.hasExprMVar || xs.any hasExprMVar
  | _              => false

end Pattern

partial def instantiatePatternMVars : Pattern → MetaM Pattern
  | Pattern.inaccessible e      => return Pattern.inaccessible (← instantiateMVars e)
  | Pattern.val e               => return Pattern.val (← instantiateMVars e)
  | Pattern.ctor n us ps fields => return Pattern.ctor n us (← ps.mapM instantiateMVars) (← fields.mapM instantiatePatternMVars)
  | Pattern.as x p h            => return Pattern.as x (← instantiatePatternMVars p) h
  | Pattern.arrayLit t xs       => return Pattern.arrayLit (← instantiateMVars t) (← xs.mapM instantiatePatternMVars)
  | p                   => return p

structure AltLHS where
  ref        : Syntax
  fvarDecls  : List LocalDecl -- Free variables used in the patterns.
  patterns   : List Pattern   -- We use `List Pattern` since we have nary match-expressions.

def instantiateAltLHSMVars (altLHS : AltLHS) : MetaM AltLHS :=
  return { altLHS with
    fvarDecls := (← altLHS.fvarDecls.mapM instantiateLocalDeclMVars),
    patterns  := (← altLHS.patterns.mapM instantiatePatternMVars)
  }

structure Alt where
  ref       : Syntax
  idx       : Nat -- for generating error messages
  rhs       : Expr
  fvarDecls : List LocalDecl
  patterns  : List Pattern
  deriving Inhabited

namespace Alt

partial def toMessageData (alt : Alt) : MetaM MessageData := do
  withExistingLocalDecls alt.fvarDecls do
    let msg : List MessageData := alt.fvarDecls.map fun d => m!"{d.toExpr}:({d.type})"
    let msg : MessageData := m!"{msg} |- {alt.patterns.map Pattern.toMessageData} => {alt.rhs}"
    addMessageContext msg

def applyFVarSubst (s : FVarSubst) (alt : Alt) : Alt :=
  { alt with
    patterns  := alt.patterns.map fun p => p.applyFVarSubst s,
    fvarDecls := alt.fvarDecls.map fun d => d.applyFVarSubst s,
    rhs       := alt.rhs.applyFVarSubst s }

def replaceFVarId (fvarId : FVarId) (v : Expr) (alt : Alt) : Alt :=
  { alt with
    patterns  := alt.patterns.map fun p => p.replaceFVarId fvarId v,
    fvarDecls :=
      let decls := alt.fvarDecls.filter fun d => d.fvarId != fvarId
      decls.map $ replaceFVarIdAtLocalDecl fvarId v,
    rhs       := alt.rhs.replaceFVarId fvarId v }

/-
  Similar to `checkAndReplaceFVarId`, but ensures type of `v` is definitionally equal to type of `fvarId`.
  This extra check is necessary when performing dependent elimination and inaccessible terms have been used.
  For example, consider the following code fragment:

```
inductive Vec (α : Type u) : Nat → Type u where
  | nil : Vec α 0
  | cons {n} (head : α) (tail : Vec α n) : Vec α (n+1)

inductive VecPred {α : Type u} (P : α → Prop) : {n : Nat} → Vec α n → Prop where
  | nil   : VecPred P Vec.nil
  | cons  {n : Nat} {head : α} {tail : Vec α n} : P head → VecPred P tail → VecPred P (Vec.cons head tail)

theorem ex {α : Type u} (P : α → Prop) : {n : Nat} → (v : Vec α (n+1)) → VecPred P v → Exists P
  | _, Vec.cons head _, VecPred.cons h (w : VecPred P Vec.nil) => ⟨head, h⟩
```
Recall that `_` in a pattern can be elaborated into pattern variable or an inaccessible term.
The elaborator uses an inaccessible term when typing constraints restrict its value.
Thus, in the example above, the `_` at `Vec.cons head _` becomes the inaccessible pattern `.(Vec.nil)`
because the type ascription `(w : VecPred P Vec.nil)` propagates typing constraints that restrict its value to be `Vec.nil`.
After elaboration the alternative becomes:
```
  | .(0), @Vec.cons .(α) .(0) head .(Vec.nil), @VecPred.cons .(α) .(P) .(0) .(head) .(Vec.nil) h w => ⟨head, h⟩
```
where
```
(head : α), (h: P head), (w : VecPred P Vec.nil)
```
Then, when we process this alternative in this module, the following check will detect that
`w` has type `VecPred P Vec.nil`, when it is supposed to have type `VecPred P tail`.
Note that if we had written
```
theorem ex {α : Type u} (P : α → Prop) : {n : Nat} → (v : Vec α (n+1)) → VecPred P v → Exists P
  | _, Vec.cons head Vec.nil, VecPred.cons h (w : VecPred P Vec.nil) => ⟨head, h⟩
```
we would get the easier to digest error message
```
missing cases:
_, (Vec.cons _ _ (Vec.cons _ _ _)), _
```
-/
def checkAndReplaceFVarId (fvarId : FVarId) (v : Expr) (alt : Alt) : MetaM Alt := do
  match alt.fvarDecls.find? fun (fvarDecl : LocalDecl) => fvarDecl.fvarId == fvarId with
  | none          => throwErrorAt alt.ref "unknown free pattern variable"
  | some fvarDecl => do
    let vType ← inferType v
    unless (← isDefEqGuarded fvarDecl.type vType) do
      withExistingLocalDecls alt.fvarDecls do
        let (expectedType, givenType) ← addPPExplicitToExposeDiff vType fvarDecl.type
        throwErrorAt alt.ref "type mismatch during dependent match-elimination at pattern variable '{mkFVar fvarDecl.fvarId}' with type{indentExpr givenType}\nexpected type{indentExpr expectedType}"
    pure $ replaceFVarId fvarId v alt

end Alt

inductive Example where
  | var        : FVarId → Example
  | underscore : Example
  | ctor       : Name → List Example → Example
  | val        : Expr → Example
  | arrayLit   : List Example → Example

namespace Example

partial def replaceFVarId (fvarId : FVarId) (ex : Example) : Example → Example
  | var x        => if x == fvarId then ex else var x
  | ctor n exs   => ctor n $ exs.map (replaceFVarId fvarId ex)
  | arrayLit exs => arrayLit $ exs.map (replaceFVarId fvarId ex)
  | ex           => ex

partial def applyFVarSubst (s : FVarSubst) : Example → Example
  | var fvarId =>
    match s.get fvarId with
    | Expr.fvar fvarId' _ => var fvarId'
    | _                   => underscore
  | ctor n exs   => ctor n $ exs.map (applyFVarSubst s)
  | arrayLit exs => arrayLit $ exs.map (applyFVarSubst s)
  | ex           => ex

partial def varsToUnderscore : Example → Example
  | var x        => underscore
  | ctor n exs   => ctor n $ exs.map varsToUnderscore
  | arrayLit exs => arrayLit $ exs.map varsToUnderscore
  | ex           => ex

partial def toMessageData : Example → MessageData
  | var fvarId        => mkFVar fvarId
  | ctor ctorName []  => mkConst ctorName
  | ctor ctorName exs => m!"({mkConst ctorName}{exs.foldl (fun msg pat => m!"{msg} {toMessageData pat}") Format.nil})"
  | arrayLit exs      => "#" ++ MessageData.ofList (exs.map toMessageData)
  | val e             => e
  | underscore        => "_"

end Example

def examplesToMessageData (cex : List Example) : MessageData :=
  MessageData.joinSep (cex.map (Example.toMessageData ∘ Example.varsToUnderscore)) ", "

structure Problem where
  mvarId        : MVarId
  vars          : List Expr
  alts          : List Alt
  examples      : List Example
  deriving Inhabited

def withGoalOf {α} (p : Problem) (x : MetaM α) : MetaM α :=
  withMVarContext p.mvarId x

def Problem.toMessageData (p : Problem) : MetaM MessageData :=
  withGoalOf p do
    let alts ← p.alts.mapM Alt.toMessageData
    let vars ← p.vars.mapM fun x => do let xType ← inferType x; pure m!"{x}:({xType})"
    return m!"remaining variables: {vars}\nalternatives:{indentD (MessageData.joinSep alts Format.line)}\nexamples:{examplesToMessageData p.examples}\n"

abbrev CounterExample := List Example

def counterExampleToMessageData (cex : CounterExample) : MessageData :=
  examplesToMessageData cex

def counterExamplesToMessageData (cexs : List CounterExample) : MessageData :=
  MessageData.joinSep (cexs.map counterExampleToMessageData) Format.line

structure MatcherResult where
  matcher         : Expr -- The matcher. It is not just `Expr.const matcherName` because the type of the major premises may contain free variables.
  counterExamples : List CounterExample
  unusedAltIdxs   : List Nat
  addMatcher      : MetaM Unit

/--
  Convert a expression occurring as the argument of a `match` motive application back into a `Pattern`
  For example, we can use this method to convert `x::y::xs` at
  ```
  ...
  (motive : List Nat → Sort u_1) (xs : List Nat) (h_1 : (x y : Nat) → (xs : List Nat) → motive (x :: y :: xs))
  ...
  ```
  into a pattern object
-/
partial def toPattern (e : Expr) : MetaM Pattern := do
  match inaccessible? e with
  | some t => return Pattern.inaccessible t
  | none =>
    match e.arrayLit? with
    | some (α, lits) =>
      return Pattern.arrayLit α (← lits.mapM toPattern)
    | none =>
      if e.isAppOfArity ``namedPattern 4 then
        let p ← toPattern <| e.getArg! 2
        match e.getArg! 1, e.getArg! 3 with
        | Expr.fvar x _, Expr.fvar h _ => return Pattern.as x p h
        | _,             _               => throwError "unexpected occurrence of auxiliary declaration 'namedPattern'"
      else if isMatchValue e then
        return Pattern.val e
      else if e.isFVar then
        return Pattern.var e.fvarId!
      else
        let newE ← whnf e
        if newE != e then
          toPattern newE
        else matchConstCtor e.getAppFn (fun _ => throwError "unexpected pattern{indentExpr e}") fun v us => do
          let args := e.getAppArgs
          unless args.size == v.numParams + v.numFields do
            throwError "unexpected pattern{indentExpr e}"
          let params := args.extract 0 v.numParams
          let fields := args.extract v.numParams args.size
          let fields ← fields.mapM toPattern
          return Pattern.ctor v.name us params.toList fields.toList

end Lean.Meta.Match


theorem False.intro : False := sorry


import tactic.interactive

lemma a {α} [nonempty α] : ∃ a : α, a = a :=
by inhabit α; use default _; refl

noncomputable def b {α} [nonempty α] : α :=
by inhabit α; apply default

lemma c {α} [nonempty α] : ∀ n : ℕ, ∃ b : α, n = n :=
by inhabit α; intro; use default _; refl

noncomputable def d {α} [nonempty α] : ∀ n : ℕ, α :=
by inhabit α; intro; apply default


example (P : Prop) : ∀ x ∈ (∅ : set ℕ), P :=
begin
  intro x,
  intro hx,
  cases hx,
end

example (P : Prop) : ∀ x ∈ (∅ : set ℕ), P :=
begin
  intros x hx, cases hx,
end


import data.pfun

/-! Need to figure out how to port over the stuff from `turing.reaches` and `turing.eval` to the slightly more
general setting with any generic `pfun` (i.e. instead of iterating `f : α → option α`, we should be able to
iterate `f : α → β ⊕ α` and more easily convert between `f.fix x`, a sequence of applications `ℕ → α` given by
`x, f(x), f(f(x)), ...`, and a `reaches`-prop `reaches x y` which indicates that `y = f(f(...f(x)))` for some number
of `f`'s.

These are useful in the `pfun` setting, not just Turing machine states.
-/

namespace pfun
lemma exists_preimage_of_fix_dom {α β : Type*} {f : α →. β ⊕ α} {a : α} {b : β} (h : b ∈ f.fix a) :
  ∃ a', sum.inl b ∈ f a' :=
by apply fix_induction' _ _ h; tauto

variables {α₁ α₂ β₁ β₂ : Type*}
variables (f₁ : α₁ →. β₁ ⊕ α₁) (f₂ : α₂ →. β₂ ⊕ α₂)

/-- We just extract a very special case, which is all we need here: two functions `f₁` and `f₂` satisfy
`frespects_once` wrt `F` if whenever `f₁` takes a single step from `a₁ : α₁` to `a₁' : α₁`, `f₂` takes
the corresponding step from `a₂ = F a₁` to `a₂' = F a₁'`, and moreover, if `f₁` diverges on a state iff `f₂` diverges
on the corresponding one, and `f₁` halts on a state iff `f₂` halts on the corresponding one.

We use a slightly weaker definition which is equivalent to the above description. -/
def frespects_once (F : α₁ → α₂) : Prop :=
∀ a₁, ((f₂ (F a₁)).dom → (f₁ a₁).dom) ∧ (∀ a₁', sum.inr a₁' ∈ f₁ a₁ → (sum.inr $ F a₁') ∈ (f₂ (F a₁)))
  ∧ ((∃ b₁, sum.inl b₁ ∈ f₁ a₁) → ∃ b₂, sum.inl b₂ ∈ f₂ (F a₁))

variables {F : α₁ → α₂} (hF : frespects_once f₁ f₂ F) {f₁ f₂}
include hF

lemma dom_iff_dom (a : α₁) : (f₁ a).dom ↔ (f₂ (F a)).dom :=
begin
  specialize hF a, split, swap, { exact hF.1, },
  { intro h,
    rw part.dom_iff_mem at h ⊢,
    obtain ⟨y, hy⟩ := h,
    cases y with ly ry,
    { obtain ⟨b₂, hb₂⟩ := hF.2.2 ⟨ly, hy⟩, use sum.inl b₂, assumption, },
    exact ⟨_, hF.2.1 ry hy⟩, }
end

lemma fwd_preimage_of_fwd {a : α₁} {a' : α₂} (ha' : sum.inr a' ∈ f₂ (F a)) : ∃ a₁', sum.inr a₁' ∈ f₁ a ∧ F a₁' = a' :=
begin
  have : (f₁ a).dom, { rw [dom_iff_dom hF a, part.dom_iff_mem], exact ⟨_, ha'⟩, },
  specialize hF a,
  suffices h : ∃ a₁', sum.inr a₁' ∈ f₁ a,
  { obtain ⟨a₁', h⟩ := h, use a₁', refine ⟨h, _⟩, exact sum.inr_injective (part.mem_unique (hF.2.1 a₁' h) ha'), },
  cases (f₁ a) with d v, cases e : v this with vb va,
  { exfalso, cases hF.2.2 ⟨vb, _⟩ with _ H, { have := part.mem_unique ha' H, contradiction, },
    use this, exact e, },
  use va, use this, exact e,
end

lemma fwd_iff_fwd (a : α₁) : (∃ a', sum.inr a' ∈ f₁ a) ↔ ∃ a', sum.inr a' ∈ f₂ (F a) :=
begin
  split; rintro ⟨a', ha'⟩,
  { exact ⟨_, (hF a).2.1 a' ha'⟩, },
  { obtain ⟨a₁', ha₁'⟩ := fwd_preimage_of_fwd hF ha', exact ⟨a₁', ha₁'.1⟩, }
end

lemma stop_iff_stop (a : α₁) : (∃ b₁, sum.inl b₁ ∈ f₁ a) ↔ ∃ b₂, sum.inl b₂ ∈ f₂ (F a) :=
begin
  split, { exact (hF a).2.2, },
  rintro ⟨b₂, hb₂⟩,
  have : (f₁ a).dom, { rw [dom_iff_dom hF a, part.dom_iff_mem], exact ⟨_, hb₂⟩, },
  have H := (fwd_iff_fwd hF a).mp,
  cases (f₁ a) with d v, cases e : v this with vb va,
  { use vb, use this, exact e, },
  exfalso, specialize H ⟨va, _⟩, { use this, exact e, },
  obtain ⟨a₂', ha₂'⟩ := H, have := part.mem_unique hb₂ ha₂', contradiction,
end

lemma frespects_last_step {a : α₁} {b₁ : β₁} {b₂ : β₂} (hb₁ : b₁ ∈ f₁.fix a) (hb₂ : b₂ ∈ f₂.fix (F a)) :
  ∃ a' : α₁, sum.inl b₁ ∈ f₁ a' ∧ sum.inl b₂ ∈ f₂ (F a') :=
begin
  revert hb₂,
  apply fix_induction' _ _ hb₁; clear hb₁ a,
  { intros a' ha' hb₂, use [a', ha'],
    obtain ⟨b₂', hb₂'⟩ := (stop_iff_stop hF a').mp ⟨b₁, ha'⟩,
    have : b₂ = b₂' := part.mem_unique hb₂ (fix_stop _ hb₂'), subst this,
    assumption, },
  intros a a' ha' ha ih hb₂,
  refine ih _,
  rwa ← fix_fwd _ _ ((hF a).2.1 _ ha),
end

variable (F)
theorem eq_dom_of_frespects_once (a : α₁) :
  (f₁.fix a).dom ↔ (f₂.fix (F a)).dom :=
begin
  split; intro h;
    rw part.dom_iff_mem at h;
    cases h with y h,
  { apply fix_induction' _ _ h; clear h a,
    { intros a h, obtain ⟨b₂, hb₂⟩ := (stop_iff_stop hF a).mp ⟨_, h⟩,
      rw [part.dom_iff_mem], use b₂, exact fix_stop _ hb₂, },
    intros a a' hy ha ha',
    rw part.dom_iff_mem at ⊢ ha',
    rw fix_fwd, { exact ha', }, exact (hF a).2.1 a' ha, },
  suffices : ∀ a', F a' = F a → (f₁.fix a').dom, { exact this a rfl, },
  apply @fix_induction' _ _ f₂ y (λ z, ∀ a', F a' = z → (f₁.fix a').dom) _ h; clear h a,
  { intros a ha a' ha', subst ha',
    have : ∃ y', sum.inl y' ∈ f₁ a', { rw stop_iff_stop hF a', exact ⟨_, ha⟩, },
    rw part.dom_iff_mem, obtain ⟨y', hy'⟩ := this, exact ⟨y', fix_stop _ hy'⟩, },
  intros a a' ha' ha ih x hx, subst hx,
  rw part.dom_iff_mem,
  obtain ⟨y', hy', hyF⟩ := fwd_preimage_of_fwd hF ha,
  specialize ih y' hyF,
  rw part.dom_iff_mem at ih,
  rwa fix_fwd _ _ hy'
end

end pfun


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default

universes u l

namespace Mathlib

/--
A difference list is a function that, given a list, returns the original
contents of the difference list prepended to the given list.

This structure supports `O(1)` `append` and `concat` operations on lists, making it
useful for append-heavy uses such as logging and pretty printing.
-/
structure dlist (α : Type u)
where
  apply : List α → List α
  invariant : ∀ (l : List α), apply l = apply [] ++ l

namespace dlist

/-- Convert a list to a dlist -/
def of_list {α : Type u} (l : List α) : dlist α :=
  mk (append l) sorry

/-- Convert a lazily-evaluated list to a dlist -/
def lazy_of_list {α : Type u} (l : thunk (List α)) : dlist α :=
  mk (fun (xs : List α) => l Unit.unit ++ xs) sorry

/-- Convert a dlist to a list -/
def to_list {α : Type u} : dlist α → List α :=
  sorry

/--  Create a dlist containing no elements -/
def empty {α : Type u} : dlist α :=
  mk id sorry

/-- Create dlist with a single element -/
def singleton {α : Type u} (x : α) : dlist α :=
  mk (List.cons x) sorry

/-- `O(1)` Prepend a single element to a dlist -/
def cons {α : Type u} (x : α) : dlist α → dlist α :=
  sorry

/-- `O(1)` Append a single element to a dlist -/
def concat {α : Type u} (x : α) : dlist α → dlist α :=
  sorry

/-- `O(1)` Append dlists -/
protected def append {α : Type u} : dlist α → dlist α → dlist α :=
  sorry

protected instance has_append {α : Type u} : Append (dlist α) :=
  { append := dlist.append }

theorem to_list_of_list {α : Type u} (l : List α) : to_list (of_list l) = l := sorry

theorem of_list_to_list {α : Type u} (l : dlist α) : of_list (to_list l) = l := sorry

theorem to_list_empty {α : Type u} : to_list empty = [] := sorry

theorem to_list_singleton {α : Type u} (x : α) : to_list (singleton x) = [x] := sorry

theorem to_list_append {α : Type u} (l₁ : dlist α) (l₂ : dlist α) : to_list (l₁ ++ l₂) = to_list l₁ ++ to_list l₂ := sorry

theorem to_list_cons {α : Type u} (x : α) (l : dlist α) : to_list (cons x l) = x :: to_list l := sorry

theorem to_list_concat {α : Type u} (x : α) (l : dlist α) : to_list (concat x l) = to_list l ++ [x] := sorry


import Lean

import Meta.Boolean
import Meta.Pull

open Lean Elab.Tactic Meta

def congDupOr (i : Nat) (nm : Ident) (last : Bool) : TacticM Syntax :=
  match i with
  | 0 =>
    if last then `(dupOr₂ $nm)
    else `(dupOr $nm)
  | (i' + 1) => do
    let nm' := mkIdent (Name.mkSimple "w")
    let r ← congDupOr i' nm' last
    let r: Term := ⟨r⟩
    `(congOrLeft (fun $nm' => $r) $nm)

-- i: the index fixed in the original list
-- j: the index of li.head! in the original list
def loop (i j n : Nat) (pivot : Expr) (li : List Expr) (nm : Ident) : TacticM Ident :=
  match li with
  | [] => return nm
  | e::es =>
    if e == pivot then do
      -- step₁: move expr that is equal to the pivot to position i + 1
      let step₁ ←
        if j > i + 1 then
          let fname ← mkIdent <$> mkFreshId
          let e ← getTypeFromName nm.getId
          let t ← instantiateMVars e
          pullIndex2 (i + 1) j nm t fname
          pure fname
        else pure nm

      -- step₂: apply congOrLeft i times with dupOr
      let step₂: Ident ← do
        let last := i + 1 == n - 1
        let tactic ← congDupOr i step₁ last
        let tactic := ⟨tactic⟩
        let fname ← mkIdent <$> mkFreshId
        evalTactic (← `(tactic| have $fname := $tactic))
        pure fname

      loop i j (n - 1) pivot es step₂
    else loop i (j + 1) n pivot es nm

def factorCore (type : Expr) (source : Ident) : TacticM Unit :=
  withMainContext do
    let mut li := collectPropsInOrChain type
    let n := li.length
    let mut answer := source
    for i in List.range n do
      li := List.drop i li
      match li with
      | [] => break
      | e::es => do
        answer ← loop i (i + 1) (li.length + i) e es answer
        let e ← getTypeFromName answer.getId
        let t ← instantiateMVars e
        li := collectPropsInOrChain t
    evalTactic (← `(tactic| exact $answer))

syntax (name := factor) "factor" term  : tactic

@[tactic factor] def evalFactor : Tactic := fun stx =>
  withMainContext do
    let e ← elabTerm stx[1] none
    let type ← inferType e
    let source := ⟨stx[1]⟩
    factorCore type source

example : A ∨ A ∨ A ∨ A ∨ B ∨ A ∨ B ∨ A ∨ C ∨ B ∨ C ∨ B ∨ A → A ∨ B ∨ C :=
  by intro h
     factor h


import «smt-lean»

example {α : Type} {z : α} {x y : list α}
  (h : (z :: x : list α) = z :: y)
 : x = y :=
begin
  veriT,
end


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

Converter monad for building simplifiers.
-/
prelude
import init.meta.tactic init.meta.simp_tactic init.meta.interactive
import init.meta.congr_lemma init.meta.match_tactic
open tactic

def tactic.id_tag.conv : unit := ()

universe u

/-- `conv α` is a tactic for discharging goals of the form `lhs ~ rhs` for some relation `~` (usually equality) and fixed lhs, rhs.
Known in the literature as a __conversion__ tactic.
So for example, if one had the lemma `p : x = y`, then the conversion for `p` would be one that solves `p`.
-/
meta def conv (α : Type u) :=
tactic α

meta instance : monad conv :=
by dunfold conv; apply_instance

meta instance : monad_fail conv :=
by dunfold conv; apply_instance

meta instance : alternative conv :=
by dunfold conv; apply_instance

namespace conv
/-- Applies the conversion `c`. Returns `(rhs,p)` where `p : r lhs rhs`. Throws away the return value of `c`.-/
meta def convert (c : conv unit) (lhs : expr) (rel : name := `eq) : tactic (expr × expr) :=
do lhs_type   ← infer_type lhs,
   rhs        ← mk_meta_var lhs_type,
   new_target ← mk_app rel [lhs, rhs],
   new_g      ← mk_meta_var new_target,
   gs         ← get_goals,
   set_goals [new_g],
   c,
   try $ any_goals reflexivity,
   n          ← num_goals,
   when (n ≠ 0) (fail "convert tactic failed, there are unsolved goals"),
   set_goals gs,
   rhs        ← instantiate_mvars rhs,
   new_g      ← instantiate_mvars new_g,
   return (rhs, new_g)

meta def lhs : conv expr :=
do (_, lhs, rhs) ← target_lhs_rhs,
   return lhs

meta def rhs : conv expr :=
do (_, lhs, rhs) ← target_lhs_rhs,
   return rhs

/-- `⊢ lhs = rhs` ~~> `⊢ lhs' = rhs` using `h : lhs = lhs'`. -/
meta def update_lhs (new_lhs : expr) (h : expr) : conv unit :=
do transitivity,
   rhs >>= unify new_lhs,
   exact h,
   t ← target >>= instantiate_mvars,
   change t

/-- Change `lhs` to something definitionally equal to it. -/
meta def change (new_lhs : expr) : conv unit :=
do (r, lhs, rhs) ← target_lhs_rhs,
   new_target ← mk_app r [new_lhs, rhs],
   tactic.change new_target
/-- Use reflexivity to prove. -/
meta def skip : conv unit :=
reflexivity
/-- Put LHS in WHNF. -/
meta def whnf : conv unit :=
lhs >>= tactic.whnf >>= change

/-- dsimp the LHS. -/
meta def dsimp (s : option simp_lemmas := none) (u : list name := []) (cfg : dsimp_config := {}) : conv unit :=
do s ← match s with
       | some s := return s
       | none   := simp_lemmas.mk_default
       end,
   l ← lhs,
   s.dsimplify u l cfg >>= change

private meta def congr_aux : list congr_arg_kind → list expr → tactic (list expr × list expr)
| []      []      := return ([], [])
| (k::ks) (a::as) := do
  (gs, largs) ← congr_aux ks as,
  match k with
  -- parameter for the congruence lemma
  | congr_arg_kind.fixed            := return $ (gs, a::largs)
  -- parameter which is a subsingleton
  | congr_arg_kind.fixed_no_param   := return $ (gs, largs)
  | congr_arg_kind.eq               := do
      a_type  ← infer_type a,
      rhs     ← mk_meta_var a_type,
      g_type  ← mk_app `eq [a, rhs],
      g       ← mk_meta_var g_type, -- proof that `a = rhs`
      return (g::gs, a::rhs::g::largs)
  | congr_arg_kind.cast             := return $ (gs, a::largs)
  | _                               := fail "congr tactic failed, unsupported congruence lemma"
  end
| ks      as := fail "congr tactic failed, unsupported congruence lemma"

/-- Take the target equality `f x y = X` and try to apply the congruence lemma for `f` to it (namely `x = x' → y = y' → f x y = f x' y'`). -/
meta def congr : conv unit :=
do (r, lhs, rhs) ← target_lhs_rhs,
   guard (r = `eq),
   let fn   := lhs.get_app_fn,
   let args := lhs.get_app_args,
   cgr_lemma ← mk_congr_lemma_simp fn (some args.length),
   g::gs ← get_goals,
   (new_gs, lemma_args) ← congr_aux cgr_lemma.arg_kinds args,
   let g_val := cgr_lemma.proof.mk_app lemma_args,
   unify g g_val,
   set_goals $ new_gs ++ gs,
   return ()

/-- Create a conversion from the function extensionality tactic.-/
meta def funext : conv unit :=
iterate' $ do
  (r, lhs, rhs) ← target_lhs_rhs,
  guard (r = `eq),
  (expr.lam n _ _ _) ← return lhs,
  tactic.applyc `funext,
  intro n,
  return ()

end conv


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic
import Mathlib.Lean3Lib.init.control.monad
import Mathlib.Lean3Lib.init.control.alternative

universes u v u_1 u_2

namespace Mathlib

namespace option

def to_monad {m : Type → Type} [Monad m] [alternative m] {A : Type} : Option A → m A := sorry

def get_or_else {α : Type u} : Option α → α → α := sorry

def is_some {α : Type u} : Option α → Bool := sorry

def is_none {α : Type u} : Option α → Bool := sorry

def get {α : Type u} {o : Option α} : ↥(is_some o) → α := sorry

def rhoare {α : Type u} : Bool → α → Option α := sorry

def lhoare {α : Type u} : α → Option α → α := sorry

infixr:1 "|>" => Mathlib.option.rhoare

infixr:1 "<|" => Mathlib.option.lhoare

protected def bind {α : Type u} {β : Type v} : Option α → (α → Option β) → Option β := sorry

protected def map {α : Type u_1} {β : Type u_2} (f : α → β) (o : Option α) : Option β :=
  option.bind o (some ∘ f)

theorem map_id {α : Type u_1} : option.map id = id := sorry

protected instance monad : Monad Option :=
  { toApplicative :=
      { toFunctor :=
          { map := option.map, mapConst := fun (α β : Type u_1) => option.map ∘ function.const β },
        toPure := { pure := some },
        toSeq :=
          { seq :=
              fun (α β : Type u_1) (f : Option (α → β)) (x : Option α) =>
                option.bind f fun (_x : α → β) => option.map _x x },
        toSeqLeft :=
          { seqLeft :=
              fun (α β : Type u_1) (a : Option α) (b : Option β) =>
                (fun (α β : Type u_1) (f : Option (α → β)) (x : Option α) =>
                    option.bind f fun (_x : α → β) => option.map _x x)
                  β α (option.map (function.const β) a) b },
        toSeqRight :=
          { seqRight :=
              fun (α β : Type u_1) (a : Option α) (b : Option β) =>
                (fun (α β : Type u_1) (f : Option (α → β)) (x : Option α) =>
                    option.bind f fun (_x : α → β) => option.map _x x)
                  β β (option.map (function.const α id) a) b } },
    toBind := { bind := option.bind } }

protected def orelse {α : Type u} : Option α → Option α → Option α := sorry

protected instance alternative : alternative Option := alternative.mk none

end option

protected instance option.inhabited (α : Type u) : Inhabited (Option α) := { default := none }

protected instance option.decidable_eq {α : Type u} [d : DecidableEq α] : DecidableEq (Option α) :=
  sorry

end Mathlib