import tactic.doc_commands
import tactic.reserved_notation

open function
local attribute [instance, priority 10] classical.prop_decidable

section miscellany

attribute [inline] and.decidable or.decidable decidable.false xor.decidable iff.decidable
  decidable.true implies.decidable not.decidable ne.decidable
  bool.decidable_eq decidable.to_bool

attribute [simp] cast_eq cast_heq

variables {α : Type*} {β : Type*}

@[reducible] def hidden {α : Sort*} {a : α} := a

def empty.elim {C : Sort*} : empty → C.

instance : subsingleton empty := ⟨λa, a.elim⟩

instance subsingleton.prod {α β : Type*} [subsingleton α] [subsingleton β] : subsingleton (α × β) :=
⟨by { intros a b, cases a, cases b, congr, }⟩

instance : decidable_eq empty := λa, a.elim

instance sort.inhabited : inhabited Sort* := ⟨punit⟩
instance sort.inhabited' : inhabited default := ⟨punit.star⟩

instance psum.inhabited_left {α β} [inhabited α] : inhabited (psum α β) := ⟨psum.inl default⟩
instance psum.inhabited_right {α β} [inhabited β] : inhabited (psum α β) := ⟨psum.inr default⟩

@[priority 10] instance decidable_eq_of_subsingleton
  {α} [subsingleton α] : decidable_eq α
| a b := is_true (subsingleton.elim a b)

@[simp] lemma eq_iff_true_of_subsingleton {α : Sort*} [subsingleton α] (x y : α) :
  x = y ↔ true :=
by cc

lemma subsingleton_of_forall_eq {α : Sort*} (x : α) (h : ∀ y, y = x) : subsingleton α :=
⟨λ a b, (h a).symm ▸ (h b).symm ▸ rfl⟩

lemma subsingleton_iff_forall_eq {α : Sort*} (x : α) : subsingleton α ↔ ∀ y, y = x :=
⟨λ h y, @subsingleton.elim _ h y x, subsingleton_of_forall_eq x⟩

lemma subtype.subsingleton (α : Sort*) [subsingleton α] (p : α → Prop) : subsingleton (subtype p) :=
⟨λ ⟨x, _⟩ ⟨y, _⟩, have x = y, from subsingleton.elim _ _, by { cases this, refl }⟩

@[simp] theorem coe_coe {α β γ} [has_coe α β] [has_coe_t β γ]
  (a : α) : (a : γ) = (a : β) := rfl

theorem coe_fn_coe_trans
  {α β γ δ} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_fun γ δ]
  (x : α) : @coe_fn α _ _ x = @coe_fn β _ _ x := rfl

theorem coe_fn_coe_trans'
  {α β γ} {δ : out_param $ _} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_fun γ (λ _, δ)]
  (x : α) : @coe_fn α _ _ x = @coe_fn β _ _ x := rfl

@[simp] theorem coe_fn_coe_base
  {α β γ} [has_coe α β] [has_coe_to_fun β γ]
  (x : α) : @coe_fn α _ _ x = @coe_fn β _ _ x := rfl

theorem coe_fn_coe_base'
  {α β} {γ : out_param $ _} [has_coe α β] [has_coe_to_fun β (λ _, γ)]
  (x : α) : @coe_fn α _ _ x = @coe_fn β _ _ x := rfl

theorem coe_sort_coe_trans
  {α β γ δ} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_sort γ δ]
  (x : α) : @coe_sort α _ _ x = @coe_sort β _ _ x := rfl

library_note "function coercion"

@[simp] theorem coe_sort_coe_base
  {α β γ} [has_coe α β] [has_coe_to_sort β γ]
  (x : α) : @coe_sort α _ _ x = @coe_sort β _ _ x := rfl

@[derive decidable_eq]
inductive {u} pempty : Sort u

def pempty.elim {C : Sort*} : pempty → C.

instance subsingleton_pempty : subsingleton pempty := ⟨λa, a.elim⟩

@[simp] lemma not_nonempty_pempty : ¬ nonempty pempty :=
assume ⟨h⟩, h.elim

@[simp] theorem forall_pempty {P : pempty → Prop} : (∀ x : pempty, P x) ↔ true :=
⟨λ h, trivial, λ h x, by cases x⟩

@[simp] theorem exists_pempty {P : pempty → Prop} : (∃ x : pempty, P x) ↔ false :=
⟨λ h, by { cases h with w, cases w }, false.elim⟩

lemma congr_heq {α β γ : Sort*} {f : α → γ} {g : β → γ} {x : α} {y : β} (h₁ : f == g)
  (h₂ : x == y) : f x = g y :=
by { cases h₂, cases h₁, refl }

lemma congr_arg_heq {α} {β : α → Sort*} (f : ∀ a, β a) : ∀ {a₁ a₂ : α}, a₁ = a₂ → f a₁ == f a₂
| a _ rfl := heq.rfl

lemma ulift.down_injective {α : Sort*} : function.injective (@ulift.down α)
| ⟨a⟩ ⟨b⟩ rfl := rfl

@[simp] lemma ulift.down_inj {α : Sort*} {a b : ulift α} : a.down = b.down ↔ a = b :=
⟨λ h, ulift.down_injective h, λ h, by rw h⟩

lemma plift.down_injective {α : Sort*} : function.injective (@plift.down α)
| ⟨a⟩ ⟨b⟩ rfl := rfl

@[simp] lemma plift.down_inj {α : Sort*} {a b : plift α} : a.down = b.down ↔ a = b :=
⟨λ h, plift.down_injective h, λ h, by rw h⟩

attribute [symm] ne.symm

lemma ne_comm {α} {a b : α} : a ≠ b ↔ b ≠ a := ⟨ne.symm, ne.symm⟩

@[simp] lemma eq_iff_eq_cancel_left {b c : α} :
  (∀ {a}, a = b ↔ a = c) ↔ (b = c) :=
⟨λ h, by rw [← h], λ h a, by rw h⟩

@[simp] lemma eq_iff_eq_cancel_right {a b : α} :
  (∀ {c}, a = c ↔ b = c) ↔ (a = b) :=
⟨λ h, by rw h, λ h a, by rw h⟩

class fact (p : Prop) : Prop := (out [] : p)

library_note "fact non-instances"

lemma fact.elim {p : Prop} (h : fact p) : p := h.1
lemma fact_iff {p : Prop} : fact p ↔ p := ⟨λ h, h.1, λ h, ⟨h⟩⟩

@[reducible] def function.swap₂ {ι₁ ι₂ : Sort*} {κ₁ : ι₁ → Sort*} {κ₂ : ι₂ → Sort*}
  {φ : Π i₁, κ₁ i₁ → Π i₂, κ₂ i₂ → Sort*} (f : Π i₁ j₁ i₂ j₂, φ i₁ j₁ i₂ j₂) :
  Π i₂ j₂ i₁ j₁, φ i₁ j₁ i₂ j₂ :=
λ i₂ j₂ i₁ j₁, f i₁ j₁ i₂ j₂

def auto_param.out {α : Sort*} {n : name} (x : auto_param α n) : α := x

def opt_param.out {α : Sort*} {d : α} (x : α := d) : α := x

end miscellany

open function

theorem false_ne_true : false ≠ true
| h := h.symm ▸ trivial

section propositional
variables {a b c d e f : Prop}

instance : is_refl Prop iff := ⟨iff.refl⟩
instance : is_trans Prop iff := ⟨λ _ _ _, iff.trans⟩

theorem iff_of_eq (e : a = b) : a ↔ b := e ▸ iff.rfl

theorem iff_iff_eq : (a ↔ b) ↔ a = b := ⟨propext, iff_of_eq⟩

@[simp] lemma eq_iff_iff {p q : Prop} : (p = q) ↔ (p ↔ q) := iff_iff_eq.symm

@[simp] theorem imp_self : (a → a) ↔ true := iff_true_intro id

lemma iff.imp (h₁ : a ↔ b) (h₂ : c ↔ d) : (a → c) ↔ (b → d) := imp_congr h₁ h₂

@[simp] lemma eq_true_eq_id : eq true = id :=
by { funext, simp only [true_iff, id.def, iff_self, eq_iff_iff], }

theorem imp_intro {α β : Prop} (h : α) : β → α := λ _, h

theorem imp_false : (a → false) ↔ ¬ a := iff.rfl

theorem imp_and_distrib {α} : (α → b ∧ c) ↔ (α → b) ∧ (α → c) :=
⟨λ h, ⟨λ ha, (h ha).left, λ ha, (h ha).right⟩,
λ h ha, ⟨h.left ha, h.right ha⟩⟩

@[simp] theorem and_imp : (a ∧ b → c) ↔ (a → b → c) :=
iff.intro (λ h ha hb, h ⟨ha, hb⟩) (λ h ⟨ha, hb⟩, h ha hb)

theorem iff_def : (a ↔ b) ↔ (a → b) ∧ (b → a) :=
iff_iff_implies_and_implies _ _

theorem iff_def' : (a ↔ b) ↔ (b → a) ∧ (a → b) :=
iff_def.trans and.comm

theorem imp_true_iff {α : Sort*} : (α → true) ↔ true :=
iff_true_intro $ λ_, trivial

theorem imp_iff_right (ha : a) : (a → b) ↔ b :=
⟨λf, f ha, imp_intro⟩

lemma imp_iff_not (hb : ¬ b) : a → b ↔ ¬ a := imp_congr_right $ λ _, iff_false_intro hb

theorem decidable.imp_iff_right_iff [decidable a] : ((a → b) ↔ b) ↔ (a ∨ b) :=
⟨λ H, (decidable.em a).imp_right $ λ ha', H.1 $ λ ha, (ha' ha).elim,
  λ H, H.elim imp_iff_right $ λ hb, ⟨λ hab, hb, λ _ _, hb⟩⟩

@[simp] theorem imp_iff_right_iff : ((a → b) ↔ b) ↔ (a ∨ b) :=
decidable.imp_iff_right_iff

lemma decidable.and_or_imp [decidable a] : (a ∧ b) ∨ (a → c) ↔ a → (b ∨ c) :=
if ha : a then by simp only [ha, true_and, true_implies_iff]
          else by simp only [ha, false_or, false_and, false_implies_iff]

@[simp] theorem and_or_imp : (a ∧ b) ∨ (a → c) ↔ a → (b ∨ c) :=
decidable.and_or_imp

def not.elim {α : Sort*} (H1 : ¬a) (H2 : a) : α := absurd H2 H1

@[reducible] theorem not.imp {a b : Prop} (H2 : ¬b) (H1 : a → b) : ¬a := mt H1 H2

theorem not_not_of_not_imp : ¬(a → b) → ¬¬a :=
mt not.elim

theorem not_of_not_imp {a : Prop} : ¬(a → b) → ¬b :=
mt imp_intro

theorem dec_em (p : Prop) [decidable p] : p ∨ ¬p := decidable.em p

theorem dec_em' (p : Prop) [decidable p] : ¬p ∨ p := (dec_em p).swap

theorem em (p : Prop) : p ∨ ¬p := classical.em _

theorem em' (p : Prop) : ¬p ∨ p := (em p).swap

theorem or_not {p : Prop} : p ∨ ¬p := em _

section eq_or_ne

variables {α : Sort*} (x y : α)

theorem decidable.eq_or_ne [decidable (x = y)] : x = y ∨ x ≠ y := dec_em $ x = y

theorem decidable.ne_or_eq [decidable (x = y)] : x ≠ y ∨ x = y := dec_em' $ x = y

theorem eq_or_ne : x = y ∨ x ≠ y := em $ x = y

theorem ne_or_eq : x ≠ y ∨ x = y := em' $ x = y

end eq_or_ne

theorem by_contradiction {p} : (¬p → false) → p := decidable.by_contradiction

theorem by_contra {p} : (¬p → false) → p := decidable.by_contradiction

library_note "decidable namespace"

library_note "decidable arguments"

protected theorem decidable.not_not [decidable a] : ¬¬a ↔ a :=
iff.intro decidable.by_contradiction not_not_intro

@[simp] theorem not_not : ¬¬a ↔ a := decidable.not_not

theorem of_not_not : ¬¬a → a := by_contra

lemma not_ne_iff {α : Sort*} {a b : α} : ¬ a ≠ b ↔ a = b := not_not

protected theorem decidable.of_not_imp [decidable a] (h : ¬ (a → b)) : a :=
decidable.by_contradiction (not_not_of_not_imp h)

theorem of_not_imp : ¬ (a → b) → a := decidable.of_not_imp

protected theorem decidable.not_imp_symm [decidable a] (h : ¬a → b) (hb : ¬b) : a :=
decidable.by_contradiction $ hb ∘ h

theorem not.decidable_imp_symm [decidable a] : (¬a → b) → ¬b → a := decidable.not_imp_symm

theorem not.imp_symm : (¬a → b) → ¬b → a := not.decidable_imp_symm

protected theorem decidable.not_imp_comm [decidable a] [decidable b] : (¬a → b) ↔ (¬b → a) :=
⟨not.decidable_imp_symm, not.decidable_imp_symm⟩

theorem not_imp_comm : (¬a → b) ↔ (¬b → a) := decidable.not_imp_comm

@[simp] theorem imp_not_self : (a → ¬a) ↔ ¬a := ⟨λ h ha, h ha ha, λ h _, h⟩

theorem decidable.not_imp_self [decidable a] : (¬a → a) ↔ a :=
by { have := @imp_not_self (¬a), rwa decidable.not_not at this }

@[simp] theorem not_imp_self : (¬a → a) ↔ a := decidable.not_imp_self

theorem imp.swap : (a → b → c) ↔ (b → a → c) :=
⟨swap, swap⟩

theorem imp_not_comm : (a → ¬b) ↔ (b → ¬a) :=
imp.swap

lemma iff.not (h : a ↔ b) : ¬ a ↔ ¬ b := not_congr h
lemma iff.not_left (h : a ↔ ¬ b) : ¬ a ↔ b := h.not.trans not_not
lemma iff.not_right (h : ¬ a ↔ b) : a ↔ ¬ b := not_not.symm.trans h.not

@[simp] theorem xor_true : xor true = not := funext $ λ a, by simp [xor]

@[simp] theorem xor_false : xor false = id := funext $ λ a, by simp [xor]

theorem xor_comm (a b) : xor a b = xor b a := by simp [xor, and_comm, or_comm]

instance : is_commutative Prop xor := ⟨xor_comm⟩

@[simp] theorem xor_self (a : Prop) : xor a a = false := by simp [xor]

lemma iff.and (h₁ : a ↔ b) (h₂ : c ↔ d) : a ∧ c ↔ b ∧ d := and_congr h₁ h₂

theorem and_congr_left (h : c → (a ↔ b)) : a ∧ c ↔ b ∧ c :=
and.comm.trans $ (and_congr_right h).trans and.comm

theorem and_congr_left' (h : a ↔ b) : a ∧ c ↔ b ∧ c := h.and iff.rfl

theorem and_congr_right' (h : b ↔ c) : a ∧ b ↔ a ∧ c := iff.rfl.and h

theorem not_and_of_not_left (b : Prop) : ¬a → ¬(a ∧ b) :=
mt and.left

theorem not_and_of_not_right (a : Prop) {b : Prop} : ¬b → ¬(a ∧ b) :=
mt and.right

theorem and.imp_left (h : a → b) : a ∧ c → b ∧ c :=
and.imp h id

theorem and.imp_right (h : a → b) : c ∧ a → c ∧ b :=
and.imp id h

lemma and.right_comm : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ b :=
by simp only [and.left_comm, and.comm]

lemma and_and_and_comm (a b c d : Prop) : (a ∧ b) ∧ c ∧ d ↔ (a ∧ c) ∧ b ∧ d :=
by rw [←and_assoc, @and.right_comm a, and_assoc]

lemma and_and_distrib_left (a b c : Prop) : a ∧ (b ∧ c) ↔ (a ∧ b) ∧ (a ∧ c) :=
by rw [and_and_and_comm, and_self]

lemma and_and_distrib_right (a b c : Prop) : (a ∧ b) ∧ c ↔ (a ∧ c) ∧ (b ∧ c) :=
by rw [and_and_and_comm, and_self]

lemma and_rotate : a ∧ b ∧ c ↔ b ∧ c ∧ a := by simp only [and.left_comm, and.comm]
lemma and.rotate : a ∧ b ∧ c → b ∧ c ∧ a := and_rotate.1

theorem and_not_self_iff (a : Prop) : a ∧ ¬ a ↔ false :=
iff.intro (assume h, (h.right) (h.left)) (assume h, h.elim)

theorem not_and_self_iff (a : Prop) : ¬ a ∧ a ↔ false :=
iff.intro (assume ⟨hna, ha⟩, hna ha) false.elim

theorem and_iff_left_of_imp {a b : Prop} (h : a → b) : (a ∧ b) ↔ a :=
iff.intro and.left (λ ha, ⟨ha, h ha⟩)

theorem and_iff_right_of_imp {a b : Prop} (h : b → a) : (a ∧ b) ↔ b :=
iff.intro and.right (λ hb, ⟨h hb, hb⟩)

@[simp] theorem and_iff_left_iff_imp {a b : Prop} : ((a ∧ b) ↔ a) ↔ (a → b) :=
⟨λ h ha, (h.2 ha).2, and_iff_left_of_imp⟩

@[simp] theorem and_iff_right_iff_imp {a b : Prop} : ((a ∧ b) ↔ b) ↔ (b → a) :=
⟨λ h ha, (h.2 ha).1, and_iff_right_of_imp⟩

@[simp] lemma iff_self_and {p q : Prop} : (p ↔ p ∧ q) ↔ (p → q) :=
by rw [@iff.comm p, and_iff_left_iff_imp]

@[simp] lemma iff_and_self {p q : Prop} : (p ↔ q ∧ p) ↔ (p → q) :=
by rw [and_comm, iff_self_and]

@[simp] lemma and.congr_right_iff : (a ∧ b ↔ a ∧ c) ↔ (a → (b ↔ c)) :=
⟨λ h ha, by simp [ha] at h; exact h, and_congr_right⟩

@[simp] lemma and.congr_left_iff : (a ∧ c ↔ b ∧ c) ↔ c → (a ↔ b) :=
by simp only [and.comm, ← and.congr_right_iff]

@[simp] lemma and_self_left : a ∧ a ∧ b ↔ a ∧ b :=
⟨λ h, ⟨h.1, h.2.2⟩, λ h, ⟨h.1, h.1, h.2⟩⟩

@[simp] lemma and_self_right : (a ∧ b) ∧ b ↔ a ∧ b :=
⟨λ h, ⟨h.1.1, h.2⟩, λ h, ⟨⟨h.1, h.2⟩, h.2⟩⟩

lemma iff.or (h₁ : a ↔ b) (h₂ : c ↔ d) : a ∨ c ↔ b ∨ d := or_congr h₁ h₂

lemma or_congr_left' (h : a ↔ b) : a ∨ c ↔ b ∨ c := h.or iff.rfl
lemma or_congr_right' (h : b ↔ c) : a ∨ b ↔ a ∨ c := iff.rfl.or h

theorem or.right_comm : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ b := by rw [or_assoc, or_assoc, or_comm b]

lemma or_or_or_comm (a b c d : Prop) : (a ∨ b) ∨ c ∨ d ↔ (a ∨ c) ∨ b ∨ d :=
by rw [←or_assoc, @or.right_comm a, or_assoc]

lemma or_or_distrib_left (a b c : Prop) : a ∨ (b ∨ c) ↔ (a ∨ b) ∨ (a ∨ c) :=
by rw [or_or_or_comm, or_self]

lemma or_or_distrib_right (a b c : Prop) : (a ∨ b) ∨ c ↔ (a ∨ c) ∨ (b ∨ c) :=
by rw [or_or_or_comm, or_self]

lemma or_rotate : a ∨ b ∨ c ↔ b ∨ c ∨ a := by simp only [or.left_comm, or.comm]
lemma or.rotate : a ∨ b ∨ c → b ∨ c ∨ a := or_rotate.1

theorem or_of_or_of_imp_of_imp (h₁ : a ∨ b) (h₂ : a → c) (h₃ : b → d) : c ∨ d :=
or.imp h₂ h₃ h₁

theorem or_of_or_of_imp_left (h₁ : a ∨ c) (h : a → b) : b ∨ c :=
or.imp_left h h₁

theorem or_of_or_of_imp_right (h₁ : c ∨ a) (h : a → b) : c ∨ b :=
or.imp_right h h₁

theorem or.elim3 (h : a ∨ b ∨ c) (ha : a → d) (hb : b → d) (hc : c → d) : d :=
or.elim h ha (assume h₂, or.elim h₂ hb hc)

lemma or.imp3 (had : a → d) (hbe : b → e) (hcf : c → f) : a ∨ b ∨ c → d ∨ e ∨ f :=
or.imp had $ or.imp hbe hcf

theorem or_imp_distrib : (a ∨ b → c) ↔ (a → c) ∧ (b → c) :=
⟨assume h, ⟨assume ha, h (or.inl ha), assume hb, h (or.inr hb)⟩,
  assume ⟨ha, hb⟩, or.rec ha hb⟩

protected theorem decidable.or_iff_not_imp_left [decidable a] : a ∨ b ↔ (¬ a → b) :=
⟨or.resolve_left, λ h, dite _ or.inl (or.inr ∘ h)⟩

theorem or_iff_not_imp_left : a ∨ b ↔ (¬ a → b) := decidable.or_iff_not_imp_left

protected theorem decidable.or_iff_not_imp_right [decidable b] : a ∨ b ↔ (¬ b → a) :=
or.comm.trans decidable.or_iff_not_imp_left

theorem or_iff_not_imp_right : a ∨ b ↔ (¬ b → a) := decidable.or_iff_not_imp_right

protected lemma decidable.not_or_of_imp [decidable a] (h : a → b) : ¬ a ∨ b :=
dite _ (or.inr ∘ h) or.inl

lemma not_or_of_imp : (a → b) → ¬ a ∨ b := decidable.not_or_of_imp

protected lemma decidable.or_not_of_imp [decidable a] (h : a → b) : b ∨ ¬ a :=
dite _ (or.inl ∘ h) or.inr

lemma or_not_of_imp : (a → b) → b ∨ ¬ a := decidable.or_not_of_imp

protected lemma decidable.imp_iff_not_or [decidable a] : a → b ↔ ¬ a ∨ b :=
⟨decidable.not_or_of_imp, or.neg_resolve_left⟩

lemma imp_iff_not_or : a → b ↔ ¬ a ∨ b := decidable.imp_iff_not_or

protected lemma decidable.imp_iff_or_not [decidable b] : b → a ↔ a ∨ ¬ b :=
decidable.imp_iff_not_or.trans or.comm

lemma imp_iff_or_not : b → a ↔ a ∨ ¬ b := decidable.imp_iff_or_not

protected theorem decidable.not_imp_not [decidable a] : (¬ a → ¬ b) ↔ (b → a) :=
⟨assume h hb, decidable.by_contradiction $ assume na, h na hb, mt⟩

theorem not_imp_not : (¬ a → ¬ b) ↔ (b → a) := decidable.not_imp_not

protected lemma decidable.or_congr_left [decidable c] (h : ¬ c → (a ↔ b)) : a ∨ c ↔ b ∨ c :=
by { rw [decidable.or_iff_not_imp_right, decidable.or_iff_not_imp_right], exact imp_congr_right h }

lemma or_congr_left (h : ¬ c → (a ↔ b)) : a ∨ c ↔ b ∨ c :=
decidable.or_congr_left h

protected lemma decidable.or_congr_right [decidable a] (h : ¬ a → (b ↔ c)) : a ∨ b ↔ a ∨ c :=
by { rw [decidable.or_iff_not_imp_left, decidable.or_iff_not_imp_left], exact imp_congr_right h }

lemma or_congr_right (h : ¬ a → (b ↔ c)) : a ∨ b ↔ a ∨ c :=
decidable.or_congr_right h

@[simp] theorem or_iff_left_iff_imp : (a ∨ b ↔ a) ↔ (b → a) :=
⟨λ h hb, h.1 (or.inr hb), or_iff_left_of_imp⟩

@[simp] theorem or_iff_right_iff_imp : (a ∨ b ↔ b) ↔ (a → b) :=
by rw [or_comm, or_iff_left_iff_imp]

lemma or_iff_left (hb : ¬ b) : a ∨ b ↔ a := ⟨λ h, h.resolve_right hb, or.inl⟩
lemma or_iff_right (ha : ¬ a) : a ∨ b ↔ b := ⟨λ h, h.resolve_left ha, or.inr⟩

theorem and_or_distrib_left : a ∧ (b ∨ c) ↔ (a ∧ b) ∨ (a ∧ c) :=
⟨λ ⟨ha, hbc⟩, hbc.imp (and.intro ha) (and.intro ha),
or.rec (and.imp_right or.inl) (and.imp_right or.inr)⟩

theorem or_and_distrib_right : (a ∨ b) ∧ c ↔ (a ∧ c) ∨ (b ∧ c) :=
(and.comm.trans and_or_distrib_left).trans (and.comm.or and.comm)

theorem or_and_distrib_left : a ∨ (b ∧ c) ↔ (a ∨ b) ∧ (a ∨ c) :=
⟨or.rec (λha, and.intro (or.inl ha) (or.inl ha)) (and.imp or.inr or.inr),
and.rec $ or.rec (imp_intro ∘ or.inl) (or.imp_right ∘ and.intro)⟩

theorem and_or_distrib_right : (a ∧ b) ∨ c ↔ (a ∨ c) ∧ (b ∨ c) :=
(or.comm.trans or_and_distrib_left).trans (or.comm.and or.comm)

@[simp] lemma or_self_left : a ∨ a ∨ b ↔ a ∨ b :=
⟨λ h, h.elim or.inl id, λ h, h.elim or.inl (or.inr ∘ or.inr)⟩

@[simp] lemma or_self_right : (a ∨ b) ∨ b ↔ a ∨ b :=
⟨λ h, h.elim id or.inr, λ h, h.elim (or.inl ∘ or.inl) or.inr⟩

lemma iff.iff (h₁ : a ↔ b) (h₂ : c ↔ d) : (a ↔ c) ↔ (b ↔ d) := iff_congr h₁ h₂

theorem iff_of_true (ha : a) (hb : b) : a ↔ b :=
⟨λ_, hb, λ _, ha⟩

theorem iff_of_false (ha : ¬a) (hb : ¬b) : a ↔ b :=
⟨ha.elim, hb.elim⟩

theorem iff_true_left (ha : a) : (a ↔ b) ↔ b :=
⟨λ h, h.1 ha, iff_of_true ha⟩

theorem iff_true_right (ha : a) : (b ↔ a) ↔ b :=
iff.comm.trans (iff_true_left ha)

theorem iff_false_left (ha : ¬a) : (a ↔ b) ↔ ¬b :=
⟨λ h, mt h.2 ha, iff_of_false ha⟩

theorem iff_false_right (ha : ¬a) : (b ↔ a) ↔ ¬b :=
iff.comm.trans (iff_false_left ha)

@[simp]
lemma iff_mpr_iff_true_intro {P : Prop} (h : P) : iff.mpr (iff_true_intro h) true.intro = h := rfl

protected theorem decidable.imp_or_distrib [decidable a] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) :=
by simp [decidable.imp_iff_not_or, or.comm, or.left_comm]

theorem imp_or_distrib : (a → b ∨ c) ↔ (a → b) ∨ (a → c) := decidable.imp_or_distrib

protected theorem decidable.imp_or_distrib' [decidable b] : (a → b ∨ c) ↔ (a → b) ∨ (a → c) :=
by by_cases b; simp [h, or_iff_right_of_imp ((∘) false.elim)]

theorem imp_or_distrib' : (a → b ∨ c) ↔ (a → b) ∨ (a → c) := decidable.imp_or_distrib'

theorem not_imp_of_and_not : a ∧ ¬ b → ¬ (a → b)
| ⟨ha, hb⟩ h := hb $ h ha

protected theorem decidable.not_imp [decidable a] : ¬(a → b) ↔ a ∧ ¬b :=
⟨λ h, ⟨decidable.of_not_imp h, not_of_not_imp h⟩, not_imp_of_and_not⟩

theorem not_imp : ¬(a → b) ↔ a ∧ ¬b := decidable.not_imp

lemma imp_imp_imp (h₀ : c → a) (h₁ : b → d) : (a → b) → (c → d) :=
assume (h₂ : a → b), h₁ ∘ h₂ ∘ h₀

protected theorem decidable.peirce (a b : Prop) [decidable a] : ((a → b) → a) → a :=
if ha : a then λ h, ha else λ h, h ha.elim

theorem peirce (a b : Prop) : ((a → b) → a) → a := decidable.peirce _ _

theorem peirce' {a : Prop} (H : ∀ b : Prop, (a → b) → a) : a := H _ id

protected theorem decidable.not_iff_not [decidable a] [decidable b] : (¬ a ↔ ¬ b) ↔ (a ↔ b) :=
by rw [@iff_def (¬ a), @iff_def' a]; exact decidable.not_imp_not.and decidable.not_imp_not

theorem not_iff_not : (¬ a ↔ ¬ b) ↔ (a ↔ b) := decidable.not_iff_not

protected theorem decidable.not_iff_comm [decidable a] [decidable b] : (¬ a ↔ b) ↔ (¬ b ↔ a) :=
by rw [@iff_def (¬ a), @iff_def (¬ b)]; exact decidable.not_imp_comm.and imp_not_comm

theorem not_iff_comm : (¬ a ↔ b) ↔ (¬ b ↔ a) := decidable.not_iff_comm

protected theorem decidable.not_iff : ∀ [decidable b], ¬ (a ↔ b) ↔ (¬ a ↔ b) :=
by intro h; cases h; simp only [h, iff_true, iff_false]

theorem not_iff : ¬ (a ↔ b) ↔ (¬ a ↔ b) := decidable.not_iff

protected theorem decidable.iff_not_comm [decidable a] [decidable b] : (a ↔ ¬ b) ↔ (b ↔ ¬ a) :=
by rw [@iff_def a, @iff_def b]; exact imp_not_comm.and decidable.not_imp_comm

theorem iff_not_comm : (a ↔ ¬ b) ↔ (b ↔ ¬ a) := decidable.iff_not_comm

protected theorem decidable.iff_iff_and_or_not_and_not [decidable b] :
  (a ↔ b) ↔ (a ∧ b) ∨ (¬ a ∧ ¬ b) :=
by { split; intro h,
    { rw h; by_cases b; [left, right]; split; assumption },
    { cases h with h h; cases h; split; intro; { contradiction <|> assumption } } }

theorem iff_iff_and_or_not_and_not : (a ↔ b) ↔ (a ∧ b) ∨ (¬ a ∧ ¬ b) :=
decidable.iff_iff_and_or_not_and_not

lemma decidable.iff_iff_not_or_and_or_not [decidable a] [decidable b] :
  (a ↔ b) ↔ ((¬a ∨ b) ∧ (a ∨ ¬b)) :=
begin
  rw [iff_iff_implies_and_implies a b],
  simp only [decidable.imp_iff_not_or, or.comm]
end

lemma iff_iff_not_or_and_or_not : (a ↔ b) ↔ ((¬a ∨ b) ∧ (a ∨ ¬b)) :=
decidable.iff_iff_not_or_and_or_not

protected theorem decidable.not_and_not_right [decidable b] : ¬(a ∧ ¬b) ↔ (a → b) :=
⟨λ h ha, h.decidable_imp_symm $ and.intro ha, λ h ⟨ha, hb⟩, hb $ h ha⟩

theorem not_and_not_right : ¬(a ∧ ¬b) ↔ (a → b) := decidable.not_and_not_right

@[inline] def decidable_of_iff (a : Prop) (h : a ↔ b) [D : decidable a] : decidable b :=
decidable_of_decidable_of_iff D h

@[inline] def decidable_of_iff' (b : Prop) (h : a ↔ b) [D : decidable b] : decidable a :=
decidable_of_decidable_of_iff D h.symm

def decidable_of_bool : ∀ (b : bool) (h : b ↔ a), decidable a
| tt h := is_true (h.1 rfl)
| ff h := is_false (mt h.2 bool.ff_ne_tt)

theorem not_and_of_not_or_not (h : ¬ a ∨ ¬ b) : ¬ (a ∧ b)
| ⟨ha, hb⟩ := or.elim h (absurd ha) (absurd hb)

protected theorem decidable.not_and_distrib [decidable a] : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
⟨λ h, if ha : a then or.inr (λ hb, h ⟨ha, hb⟩) else or.inl ha, not_and_of_not_or_not⟩

protected theorem decidable.not_and_distrib' [decidable b] : ¬ (a ∧ b) ↔ ¬a ∨ ¬b :=
⟨λ h, if hb : b then or.inl (λ ha, h ⟨ha, hb⟩) else or.inr hb, not_and_of_not_or_not⟩

theorem not_and_distrib : ¬ (a ∧ b) ↔ ¬a ∨ ¬b := decidable.not_and_distrib

@[simp] theorem not_and : ¬ (a ∧ b) ↔ (a → ¬ b) := and_imp

theorem not_and' : ¬ (a ∧ b) ↔ b → ¬a :=
not_and.trans imp_not_comm

theorem not_or_distrib : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b :=
⟨λ h, ⟨λ ha, h (or.inl ha), λ hb, h (or.inr hb)⟩,
λ ⟨h₁, h₂⟩ h, or.elim h h₁ h₂⟩

protected theorem decidable.or_iff_not_and_not [decidable a] [decidable b] : a ∨ b ↔ ¬ (¬a ∧ ¬b) :=
by rw [← not_or_distrib, decidable.not_not]

theorem or_iff_not_and_not : a ∨ b ↔ ¬ (¬a ∧ ¬b) := decidable.or_iff_not_and_not

protected theorem decidable.and_iff_not_or_not [decidable a] [decidable b] :
  a ∧ b ↔ ¬ (¬ a ∨ ¬ b) :=
by rw [← decidable.not_and_distrib, decidable.not_not]

theorem and_iff_not_or_not : a ∧ b ↔ ¬ (¬ a ∨ ¬ b) := decidable.and_iff_not_or_not

@[simp] theorem not_xor (P Q : Prop) : ¬ xor P Q ↔ (P ↔ Q) :=
by simp only [not_and, xor, not_or_distrib, not_not, ← iff_iff_implies_and_implies]

theorem xor_iff_not_iff (P Q : Prop) : xor P Q ↔ ¬ (P ↔ Q) :=
by rw [iff_not_comm, not_xor]

end propositional

section mem
variables {α β : Type*} [has_mem α β] {s t : β} {a b : α}

lemma ne_of_mem_of_not_mem (h : a ∈ s) : b ∉ s → a ≠ b := mt $ λ e, e ▸ h
lemma ne_of_mem_of_not_mem' (h : a ∈ s) : a ∉ t → s ≠ t := mt $ λ e, e ▸ h

lemma has_mem.mem.ne_of_not_mem : a ∈ s → b ∉ s → a ≠ b := ne_of_mem_of_not_mem
lemma has_mem.mem.ne_of_not_mem' : a ∈ s → a ∉ t → s ≠ t := ne_of_mem_of_not_mem'

end mem

section equality
variables {α : Sort*} {a b : α}

@[simp] theorem heq_iff_eq : a == b ↔ a = b :=
⟨eq_of_heq, heq_of_eq⟩

theorem proof_irrel_heq {p q : Prop} (hp : p) (hq : q) : hp == hq :=
have p = q, from propext ⟨λ _, hq, λ _, hp⟩,
by subst q; refl

lemma ball_cond_comm {α} {s : α → Prop} {p : α → α → Prop} :
  (∀ a, s a → ∀ b, s b → p a b) ↔ (∀ a b, s a → s b → p a b) :=
⟨λ h a b ha hb, h a ha b hb, λ h a ha b hb, h a b ha hb⟩

lemma ball_mem_comm {α β} [has_mem α β] {s : β} {p : α → α → Prop} :
  (∀ a b ∈ s, p a b) ↔ (∀ a b, a ∈ s → b ∈ s → p a b) :=
ball_cond_comm

lemma ne_of_apply_ne {α β : Sort*} (f : α → β) {x y : α} (h : f x ≠ f y) : x ≠ y :=
λ (w : x = y), h (congr_arg f w)

theorem eq_equivalence : equivalence (@eq α) :=
⟨eq.refl, @eq.symm _, @eq.trans _⟩

@[simp]
lemma eq_rec_constant {α : Sort*} {a a' : α} {β : Sort*} (y : β) (h : a = a') :
  (@eq.rec α a (λ a, β) y a' h) = y :=
by { cases h, refl, }

@[simp]
lemma eq_mp_eq_cast {α β : Sort*} (h : α = β) : eq.mp h = cast h := rfl

@[simp]
lemma eq_mpr_eq_cast {α β : Sort*} (h : α = β) : eq.mpr h = cast h.symm := rfl

@[simp]
lemma cast_cast : ∀ {α β γ : Sort*} (ha : α = β) (hb : β = γ) (a : α),
  cast hb (cast ha a) = cast (ha.trans hb) a
| _ _ _ rfl rfl a := rfl

@[simp] lemma congr_refl_left {α β : Sort*} (f : α → β) {a b : α} (h : a = b) :
  congr (eq.refl f) h = congr_arg f h :=
rfl

@[simp] lemma congr_refl_right {α β : Sort*} {f g : α → β} (h : f = g) (a : α) :
  congr h (eq.refl a) = congr_fun h a :=
rfl

@[simp] lemma congr_arg_refl {α β : Sort*} (f : α → β) (a : α) :
  congr_arg f (eq.refl a) = eq.refl (f a) :=
rfl

@[simp] lemma congr_fun_rfl {α β : Sort*} (f : α → β) (a : α) :
  congr_fun (eq.refl f) a = eq.refl (f a) :=
rfl

@[simp] lemma congr_fun_congr_arg {α β γ : Sort*} (f : α → β → γ) {a a' : α} (p : a = a') (b : β) :
  congr_fun (congr_arg f p) b = congr_arg (λ a, f a b) p :=
rfl

lemma heq_of_cast_eq :
  ∀ {α β : Sort*} {a : α} {a' : β} (e : α = β) (h₂ : cast e a = a'), a == a'
| α._ a a' rfl h := eq.rec_on h (heq.refl _)

lemma cast_eq_iff_heq {α β : Sort*} {a : α} {a' : β} {e : α = β} : cast e a = a' ↔ a == a' :=
⟨heq_of_cast_eq _, λ h, by cases h; refl⟩

lemma rec_heq_of_heq {β} {C : α → Sort*} {x : C a} {y : β} (eq : a = b) (h : x == y) :
  @eq.rec α a C x b eq == y :=
by subst eq; exact h

protected lemma eq.congr {x₁ x₂ y₁ y₂ : α} (h₁ : x₁ = y₁) (h₂ : x₂ = y₂) :
  (x₁ = x₂) ↔ (y₁ = y₂) :=
by { subst h₁, subst h₂ }

lemma eq.congr_left {x y z : α} (h : x = y) : x = z ↔ y = z := by rw [h]
lemma eq.congr_right {x y z : α} (h : x = y) : z = x ↔ z = y := by rw [h]

lemma congr_arg2 {α β γ : Sort*} (f : α → β → γ) {x x' : α} {y y' : β}
  (hx : x = x') (hy : y = y') : f x y = f x' y' :=
by { subst hx, subst hy }

variables {β : α → Sort*} {γ : Π a, β a → Sort*} {δ : Π a b, γ a b → Sort*}

lemma congr_fun₂ {f g : Π a b, γ a b} (h : f = g) (a : α) (b : β a) : f a b = g a b :=
congr_fun (congr_fun h _) _

lemma congr_fun₃ {f g : Π a b c, δ a b c} (h : f = g) (a : α) (b : β a) (c : γ a b) :
  f a b c = g a b c :=
congr_fun₂ (congr_fun h _) _ _

lemma funext₂ {f g : Π a, β a → Prop} (h : ∀ a b, f a b = g a b) : f = g :=
funext $ λ _, funext $ h _

lemma funext₃ {f g : Π a b, γ a b → Prop} (h : ∀ a b c, f a b c = g a b c) : f = g :=
funext $ λ _, funext₂ $ h _

end equality

section quantifiers
variables {α : Sort*}

section dependent
variables {β : α → Sort*} {γ : Π a, β a → Sort*} {δ : Π a b, γ a b → Sort*}
  {ε : Π a b c, δ a b c → Sort*}

lemma pi_congr {β' : α → Sort*} (h : ∀ a, β a = β' a) : (Π a, β a) = Π a, β' a :=
(funext h : β = β') ▸ rfl

lemma forall₂_congr {p q : Π a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) :
  (∀ a b, p a b) ↔ ∀ a b, q a b :=
forall_congr $ λ a, forall_congr $ h a

lemma forall₃_congr {p q : Π a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) :
  (∀ a b c, p a b c) ↔ ∀ a b c, q a b c :=
forall_congr $ λ a, forall₂_congr $ h a

lemma forall₄_congr {p q : Π a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) :
  (∀ a b c d, p a b c d) ↔ ∀ a b c d, q a b c d :=
forall_congr $ λ a, forall₃_congr $ h a

lemma forall₅_congr {p q : Π a b c d, ε a b c d → Prop}
  (h : ∀ a b c d e, p a b c d e ↔ q a b c d e) :
  (∀ a b c d e, p a b c d e) ↔ ∀ a b c d e, q a b c d e :=
forall_congr $ λ a, forall₄_congr $ h a

lemma exists₂_congr {p q : Π a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) :
  (∃ a b, p a b) ↔ ∃ a b, q a b :=
exists_congr $ λ a, exists_congr $ h a

lemma exists₃_congr {p q : Π a b, γ a b → Prop} (h : ∀ a b c, p a b c ↔ q a b c) :
  (∃ a b c, p a b c) ↔ ∃ a b c, q a b c :=
exists_congr $ λ a, exists₂_congr $ h a

lemma exists₄_congr {p q : Π a b c, δ a b c → Prop} (h : ∀ a b c d, p a b c d ↔ q a b c d) :
  (∃ a b c d, p a b c d) ↔ ∃ a b c d, q a b c d :=
exists_congr $ λ a, exists₃_congr $ h a

lemma exists₅_congr {p q : Π a b c d, ε a b c d → Prop}
  (h : ∀ a b c d e, p a b c d e ↔ q a b c d e) :
  (∃ a b c d e, p a b c d e) ↔ ∃ a b c d e, q a b c d e :=
exists_congr $ λ a, exists₄_congr $ h a

lemma forall_imp {p q : α → Prop} (h : ∀ a, p a → q a) : (∀ a, p a) → ∀ a, q a := λ h' a, h a (h' a)

lemma forall₂_imp {p q : Π a, β a → Prop} (h : ∀ a b, p a b → q a b) :
  (∀ a b, p a b) → ∀ a b, q a b :=
forall_imp $ λ i, forall_imp $ h i

lemma forall₃_imp {p q : Π a b, γ a b → Prop} (h : ∀ a b c, p a b c → q a b c) :
  (∀ a b c, p a b c) → ∀ a b c, q a b c :=
forall_imp $ λ a, forall₂_imp $ h a

lemma Exists.imp {p q : α → Prop} (h : ∀ a, (p a → q a)) : (∃ a, p a) → ∃ a, q a :=
exists_imp_exists h

lemma Exists₂.imp {p q : Π a, β a → Prop} (h : ∀ a b, p a b → q a b) :
  (∃ a b, p a b) → ∃ a b, q a b :=
Exists.imp $ λ a, Exists.imp $ h a

lemma Exists₃.imp {p q : Π a b, γ a b → Prop} (h : ∀ a b c, p a b c → q a b c) :
  (∃ a b c, p a b c) → ∃ a b c, q a b c :=
Exists.imp $ λ a, Exists₂.imp $ h a

end dependent

variables {ι β : Sort*} {κ : ι → Sort*} {p q : α → Prop} {b : Prop}

lemma exists_imp_exists' {p : α → Prop} {q : β → Prop} (f : α → β) (hpq : ∀ a, p a → q (f a))
  (hp : ∃ a, p a) : ∃ b, q b :=
exists.elim hp (λ a hp', ⟨_, hpq _ hp'⟩)

theorem forall_swap {p : α → β → Prop} : (∀ x y, p x y) ↔ ∀ y x, p x y :=
⟨swap, swap⟩

lemma forall₂_swap {ι₁ ι₂ : Sort*} {κ₁ : ι₁ → Sort*} {κ₂ : ι₂ → Sort*}
  {p : Π i₁, κ₁ i₁ → Π i₂, κ₂ i₂ → Prop} :
  (∀ i₁ j₁ i₂ j₂, p i₁ j₁ i₂ j₂) ↔ ∀ i₂ j₂ i₁ j₁, p i₁ j₁ i₂ j₂ :=
⟨swap₂, swap₂⟩

lemma imp_forall_iff {α : Type*} {p : Prop} {q : α → Prop} : (p → ∀ x, q x) ↔ (∀ x, p → q x) :=
forall_swap

theorem exists_swap {p : α → β → Prop} : (∃ x y, p x y) ↔ ∃ y x, p x y :=
⟨λ ⟨x, y, h⟩, ⟨y, x, h⟩, λ ⟨y, x, h⟩, ⟨x, y, h⟩⟩

@[simp] theorem forall_exists_index {q : (∃ x, p x) → Prop} :
  (∀ h, q h) ↔ ∀ x (h : p x), q ⟨x, h⟩ :=
⟨λ h x hpx, h ⟨x, hpx⟩, λ h ⟨x, hpx⟩, h x hpx⟩

theorem exists_imp_distrib : ((∃ x, p x) → b) ↔ ∀ x, p x → b :=
forall_exists_index

@[reducible] noncomputable def Exists.some {p : α → Prop} (P : ∃ a, p a) : α := classical.some P

lemma Exists.some_spec {p : α → Prop} (P : ∃ a, p a) : p (P.some) := classical.some_spec P

theorem not_exists_of_forall_not (h : ∀ x, ¬ p x) : ¬ ∃ x, p x :=
exists_imp_distrib.2 h

@[simp] theorem not_exists : (¬ ∃ x, p x) ↔ ∀ x, ¬ p x :=
exists_imp_distrib

theorem not_forall_of_exists_not : (∃ x, ¬ p x) → ¬ ∀ x, p x
| ⟨x, hn⟩ h := hn (h x)

protected theorem decidable.not_forall {p : α → Prop}
  [decidable (∃ x, ¬ p x)] [∀ x, decidable (p x)] : (¬ ∀ x, p x) ↔ ∃ x, ¬ p x :=
⟨not.decidable_imp_symm $ λ nx x, nx.decidable_imp_symm $ λ h, ⟨x, h⟩,
not_forall_of_exists_not⟩

@[simp] theorem not_forall {p : α → Prop} : (¬ ∀ x, p x) ↔ ∃ x, ¬ p x := decidable.not_forall

protected theorem decidable.not_forall_not [decidable (∃ x, p x)] :
  (¬ ∀ x, ¬ p x) ↔ ∃ x, p x :=
(@decidable.not_iff_comm _ _ _ (decidable_of_iff (¬ ∃ x, p x) not_exists)).1 not_exists

theorem not_forall_not : (¬ ∀ x, ¬ p x) ↔ ∃ x, p x := decidable.not_forall_not

protected theorem decidable.not_exists_not [∀ x, decidable (p x)] : (¬ ∃ x, ¬ p x) ↔ ∀ x, p x :=
by simp [decidable.not_not]

@[simp] theorem not_exists_not : (¬ ∃ x, ¬ p x) ↔ ∀ x, p x := decidable.not_exists_not

theorem forall_imp_iff_exists_imp [ha : nonempty α] : ((∀ x, p x) → b) ↔ ∃ x, p x → b :=
let ⟨a⟩ := ha in
⟨λ h, not_forall_not.1 $ λ h', classical.by_cases (λ hb : b, h' a $ λ _, hb)
  (λ hb, hb $ h $ λ x, (not_imp.1 (h' x)).1), λ ⟨x, hx⟩ h, hx (h x)⟩

theorem forall_true_iff : (α → true) ↔ true :=
implies_true_iff α

theorem forall_true_iff' (h : ∀ a, p a ↔ true) : (∀ a, p a) ↔ true :=
iff_true_intro (λ _, of_iff_true (h _))

@[simp] theorem forall_2_true_iff {β : α → Sort*} : (∀ a, β a → true) ↔ true :=
forall_true_iff' $ λ _, forall_true_iff

@[simp] theorem forall_3_true_iff {β : α → Sort*} {γ : Π a, β a → Sort*} :
  (∀ a (b : β a), γ a b → true) ↔ true :=
forall_true_iff' $ λ _, forall_2_true_iff

lemma exists_unique.exists {α : Sort*} {p : α → Prop} (h : ∃! x, p x) : ∃ x, p x :=
exists.elim h (λ x hx, ⟨x, and.left hx⟩)

@[simp] lemma exists_unique_iff_exists {α : Sort*} [subsingleton α] {p : α → Prop} :
  (∃! x, p x) ↔ ∃ x, p x :=
⟨λ h, h.exists, Exists.imp $ λ x hx, ⟨hx, λ y _, subsingleton.elim y x⟩⟩

@[simp] theorem forall_const (α : Sort*) [i : nonempty α] : (α → b) ↔ b :=
⟨i.elim, λ hb x, hb⟩

@[simp] theorem exists_const (α : Sort*) [i : nonempty α] : (∃ x : α, b) ↔ b :=
⟨λ ⟨x, h⟩, h, i.elim exists.intro⟩

theorem exists_unique_const (α : Sort*) [i : nonempty α] [subsingleton α] :
  (∃! x : α, b) ↔ b :=
by simp

theorem forall_and_distrib : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
⟨λ h, ⟨λ x, (h x).left, λ x, (h x).right⟩, λ ⟨h₁, h₂⟩ x, ⟨h₁ x, h₂ x⟩⟩

theorem exists_or_distrib : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
⟨λ ⟨x, hpq⟩, hpq.elim (λ hpx, or.inl ⟨x, hpx⟩) (λ hqx, or.inr ⟨x, hqx⟩),
λ hepq, hepq.elim (λ ⟨x, hpx⟩, ⟨x, or.inl hpx⟩) (λ ⟨x, hqx⟩, ⟨x, or.inr hqx⟩)⟩

@[simp] theorem exists_and_distrib_left {q : Prop} {p : α → Prop} :
  (∃x, q ∧ p x) ↔ q ∧ (∃x, p x) :=
⟨λ ⟨x, hq, hp⟩, ⟨hq, x, hp⟩, λ ⟨hq, x, hp⟩, ⟨x, hq, hp⟩⟩

@[simp] theorem exists_and_distrib_right {q : Prop} {p : α → Prop} :
  (∃x, p x ∧ q) ↔ (∃x, p x) ∧ q :=
by simp [and_comm]

@[simp] theorem forall_eq {a' : α} : (∀a, a = a' → p a) ↔ p a' :=
⟨λ h, h a' rfl, λ h a e, e.symm ▸ h⟩

@[simp] theorem forall_eq' {a' : α} : (∀a, a' = a → p a) ↔ p a' :=
by simp [@eq_comm _ a']

theorem and_forall_ne (a : α) : (p a ∧ ∀ b ≠ a, p b) ↔ ∀ b, p b :=
by simp only [← @forall_eq _ p a, ← forall_and_distrib, ← or_imp_distrib, classical.em,
  forall_const]

@[simp] theorem forall_eq_or_imp {a' : α} : (∀ a, a = a' ∨ q a → p a) ↔ p a' ∧ ∀ a, q a → p a :=
by simp only [or_imp_distrib, forall_and_distrib, forall_eq]

theorem exists_eq {a' : α} : ∃ a, a = a' := ⟨_, rfl⟩

@[simp] theorem exists_eq' {a' : α} : ∃ a, a' = a := ⟨_, rfl⟩

@[simp] theorem exists_unique_eq {a' : α} : ∃! a, a = a' :=
by simp only [eq_comm, exists_unique, and_self, forall_eq', exists_eq']

@[simp] theorem exists_unique_eq' {a' : α} : ∃! a, a' = a :=
by simp only [exists_unique, and_self, forall_eq', exists_eq']

@[simp] theorem exists_eq_left {a' : α} : (∃ a, a = a' ∧ p a) ↔ p a' :=
⟨λ ⟨a, e, h⟩, e ▸ h, λ h, ⟨_, rfl, h⟩⟩

@[simp] theorem exists_eq_right {a' : α} : (∃ a, p a ∧ a = a') ↔ p a' :=
(exists_congr $ by exact λ a, and.comm).trans exists_eq_left

@[simp] theorem exists_eq_right_right {a' : α} :
  (∃ (a : α), p a ∧ q a ∧ a = a') ↔ p a' ∧ q a' :=
⟨λ ⟨_, hp, hq, rfl⟩, ⟨hp, hq⟩, λ ⟨hp, hq⟩, ⟨a', hp, hq, rfl⟩⟩

@[simp] theorem exists_eq_right_right' {a' : α} :
  (∃ (a : α), p a ∧ q a ∧ a' = a) ↔ p a' ∧ q a' :=
⟨λ ⟨_, hp, hq, rfl⟩, ⟨hp, hq⟩, λ ⟨hp, hq⟩, ⟨a', hp, hq, rfl⟩⟩

@[simp] theorem exists_apply_eq_apply (f : α → β) (a' : α) : ∃ a, f a = f a' := ⟨a', rfl⟩

@[simp] theorem exists_apply_eq_apply' (f : α → β) (a' : α) : ∃ a, f a' = f a := ⟨a', rfl⟩

@[simp] theorem exists_exists_and_eq_and {f : α → β} {p : α → Prop} {q : β → Prop} :
  (∃ b, (∃ a, p a ∧ f a = b) ∧ q b) ↔ ∃ a, p a ∧ q (f a) :=
⟨λ ⟨b, ⟨a, ha, hab⟩, hb⟩, ⟨a, ha, hab.symm ▸ hb⟩, λ ⟨a, hp, hq⟩, ⟨f a, ⟨a, hp, rfl⟩, hq⟩⟩

@[simp] theorem exists_exists_eq_and {f : α → β} {p : β → Prop} :
  (∃ b, (∃ a, f a = b) ∧ p b) ↔ ∃ a, p (f a) :=
⟨λ ⟨b, ⟨a, ha⟩, hb⟩, ⟨a, ha.symm ▸ hb⟩, λ ⟨a, ha⟩, ⟨f a, ⟨a, rfl⟩, ha⟩⟩

@[simp] lemma exists_or_eq_left (y : α) (p : α → Prop) : ∃ (x : α), x = y ∨ p x :=
⟨y, or.inl rfl⟩

@[simp] lemma exists_or_eq_right (y : α) (p : α → Prop) : ∃ (x : α), p x ∨ x = y :=
⟨y, or.inr rfl⟩

@[simp] lemma exists_or_eq_left' (y : α) (p : α → Prop) : ∃ (x : α), y = x ∨ p x :=
⟨y, or.inl rfl⟩

@[simp] lemma exists_or_eq_right' (y : α) (p : α → Prop) : ∃ (x : α), p x ∨ y = x :=
⟨y, or.inr rfl⟩

@[simp] theorem forall_apply_eq_imp_iff {f : α → β} {p : β → Prop} :
  (∀ a, ∀ b, f a = b → p b) ↔ (∀ a, p (f a)) :=
⟨λ h a, h a (f a) rfl, λ h a b hab, hab ▸ h a⟩

@[simp] theorem forall_apply_eq_imp_iff' {f : α → β} {p : β → Prop} :
  (∀ b, ∀ a, f a = b → p b) ↔ (∀ a, p (f a)) :=
by { rw forall_swap, simp }

@[simp] theorem forall_eq_apply_imp_iff {f : α → β} {p : β → Prop} :
  (∀ a, ∀ b, b = f a → p b) ↔ (∀ a, p (f a)) :=
by simp [@eq_comm _ _ (f _)]

@[simp] theorem forall_eq_apply_imp_iff' {f : α → β} {p : β → Prop} :
  (∀ b, ∀ a, b = f a → p b) ↔ (∀ a, p (f a)) :=
by { rw forall_swap, simp }

@[simp] theorem forall_apply_eq_imp_iff₂ {f : α → β} {p : α → Prop} {q : β → Prop} :
  (∀ b, ∀ a, p a → f a = b → q b) ↔ ∀ a, p a → q (f a) :=
⟨λ h a ha, h (f a) a ha rfl, λ h b a ha hb, hb ▸ h a ha⟩

@[simp] theorem exists_eq_left' {a' : α} : (∃ a, a' = a ∧ p a) ↔ p a' :=
by simp [@eq_comm _ a']

@[simp] theorem exists_eq_right' {a' : α} : (∃ a, p a ∧ a' = a) ↔ p a' :=
by simp [@eq_comm _ a']

theorem exists_comm {p : α → β → Prop} : (∃ a b, p a b) ↔ ∃ b a, p a b :=
⟨λ ⟨a, b, h⟩, ⟨b, a, h⟩, λ ⟨b, a, h⟩, ⟨a, b, h⟩⟩

lemma exists₂_comm {ι₁ ι₂ : Sort*} {κ₁ : ι₁ → Sort*} {κ₂ : ι₂ → Sort*}
  {p : Π i₁, κ₁ i₁ → Π i₂, κ₂ i₂ → Prop} :
  (∃ i₁ j₁ i₂ j₂, p i₁ j₁ i₂ j₂) ↔ ∃ i₂ j₂ i₁ j₁, p i₁ j₁ i₂ j₂ :=
by simp only [@exists_comm (κ₁ _), @exists_comm ι₁]

theorem and.exists {p q : Prop} {f : p ∧ q → Prop} : (∃ h, f h) ↔ ∃ hp hq, f ⟨hp, hq⟩ :=
⟨λ ⟨h, H⟩, ⟨h.1, h.2, H⟩, λ ⟨hp, hq, H⟩, ⟨⟨hp, hq⟩, H⟩⟩

theorem forall_or_of_or_forall (h : b ∨ ∀x, p x) (x) : b ∨ p x :=
h.imp_right $ λ h₂, h₂ x

protected theorem decidable.forall_or_distrib_left {q : Prop} {p : α → Prop} [decidable q] :
  (∀x, q ∨ p x) ↔ q ∨ (∀x, p x) :=
⟨λ h, if hq : q then or.inl hq else or.inr $ λ x, (h x).resolve_left hq,
  forall_or_of_or_forall⟩

theorem forall_or_distrib_left {q : Prop} {p : α → Prop} :
  (∀x, q ∨ p x) ↔ q ∨ (∀x, p x) := decidable.forall_or_distrib_left

protected theorem decidable.forall_or_distrib_right {q : Prop} {p : α → Prop} [decidable q] :
  (∀x, p x ∨ q) ↔ (∀x, p x) ∨ q :=
by simp [or_comm, decidable.forall_or_distrib_left]

theorem forall_or_distrib_right {q : Prop} {p : α → Prop} :
  (∀x, p x ∨ q) ↔ (∀x, p x) ∨ q := decidable.forall_or_distrib_right

@[simp] theorem exists_prop {p q : Prop} : (∃ h : p, q) ↔ p ∧ q :=
⟨λ ⟨h₁, h₂⟩, ⟨h₁, h₂⟩, λ ⟨h₁, h₂⟩, ⟨h₁, h₂⟩⟩

theorem exists_unique_prop {p q : Prop} : (∃! h : p, q) ↔ p ∧ q :=
by simp

@[simp] theorem exists_false : ¬ (∃a:α, false) := assume ⟨a, h⟩, h

@[simp] lemma exists_unique_false : ¬ (∃! (a : α), false) := assume ⟨a, h, h'⟩, h

theorem Exists.fst {p : b → Prop} : Exists p → b
| ⟨h, _⟩ := h

theorem Exists.snd {p : b → Prop} : ∀ h : Exists p, p h.fst
| ⟨_, h⟩ := h

theorem forall_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∀ h' : p, q h') ↔ q h :=
@forall_const (q h) p ⟨h⟩

theorem exists_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∃ h' : p, q h') ↔ q h :=
@exists_const (q h) p ⟨h⟩

lemma exists_iff_of_forall {p : Prop} {q : p → Prop} (h : ∀ h, q h) : (∃ h, q h) ↔ p :=
⟨Exists.fst, λ H, ⟨H, h H⟩⟩

theorem exists_unique_prop_of_true {p : Prop} {q : p → Prop} (h : p) : (∃! h' : p, q h') ↔ q h :=
@exists_unique_const (q h) p ⟨h⟩ _

theorem forall_prop_of_false {p : Prop} {q : p → Prop} (hn : ¬ p) :
  (∀ h' : p, q h') ↔ true :=
iff_true_intro $ λ h, hn.elim h

theorem exists_prop_of_false {p : Prop} {q : p → Prop} : ¬ p → ¬ (∃ h' : p, q h') :=
mt Exists.fst

@[congr] lemma exists_prop_congr {p p' : Prop} {q q' : p → Prop}
  (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : Exists q ↔ ∃ h : p', q' (hp.2 h) :=
⟨λ ⟨_, _⟩, ⟨hp.1 ‹_›, (hq _).1 ‹_›⟩, λ ⟨_, _⟩, ⟨_, (hq _).2 ‹_›⟩⟩

@[congr] lemma exists_prop_congr' {p p' : Prop} {q q' : p → Prop}
  (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : Exists q = ∃ h : p', q' (hp.2 h) :=
propext (exists_prop_congr hq _)

@[simp] lemma exists_true_left (p : true → Prop) : (∃ x, p x) ↔ p true.intro :=
exists_prop_of_true _

@[simp] lemma exists_false_left (p : false → Prop) : ¬ ∃ x, p x :=
exists_prop_of_false not_false

lemma exists_unique.unique {α : Sort*} {p : α → Prop} (h : ∃! x, p x)
  {y₁ y₂ : α} (py₁ : p y₁) (py₂ : p y₂) : y₁ = y₂ :=
unique_of_exists_unique h py₁ py₂

@[congr] lemma forall_prop_congr {p p' : Prop} {q q' : p → Prop}
  (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : (∀ h, q h) ↔ ∀ h : p', q' (hp.2 h) :=
⟨λ h1 h2, (hq _).1 (h1 (hp.2 _)), λ h1 h2, (hq _).2 (h1 (hp.1 h2))⟩

@[congr] lemma forall_prop_congr' {p p' : Prop} {q q' : p → Prop}
  (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : (∀ h, q h) = ∀ h : p', q' (hp.2 h) :=
propext (forall_prop_congr hq _)

@[simp] lemma forall_true_left (p : true → Prop) : (∀ x, p x) ↔ p true.intro :=
forall_prop_of_true _

@[simp] lemma forall_false_left (p : false → Prop) : (∀ x, p x) ↔ true :=
forall_prop_of_false not_false

lemma exists_unique.elim2 {α : Sort*} {p : α → Sort*} [∀ x, subsingleton (p x)]
  {q : Π x (h : p x), Prop} {b : Prop} (h₂ : ∃! x (h : p x), q x h)
  (h₁ : ∀ x (h : p x), q x h → (∀ y (hy : p y), q y hy → y = x) → b) : b :=
begin
  simp only [exists_unique_iff_exists] at h₂,
  apply h₂.elim,
  exact λ x ⟨hxp, hxq⟩ H, h₁ x hxp hxq (λ y hyp hyq, H y ⟨hyp, hyq⟩)
end

lemma exists_unique.intro2 {α : Sort*} {p : α → Sort*} [∀ x, subsingleton (p x)]
  {q : Π (x : α) (h : p x), Prop} (w : α) (hp : p w) (hq : q w hp)
  (H : ∀ y (hy : p y), q y hy → y = w) :
  ∃! x (hx : p x), q x hx :=
begin
  simp only [exists_unique_iff_exists],
  exact exists_unique.intro w ⟨hp, hq⟩ (λ y ⟨hyp, hyq⟩, H y hyp hyq)
end

lemma exists_unique.exists2 {α : Sort*} {p : α → Sort*} {q : Π (x : α) (h : p x), Prop}
  (h : ∃! x (hx : p x), q x hx) :
  ∃ x (hx : p x), q x hx :=
h.exists.imp (λ x hx, hx.exists)

lemma exists_unique.unique2 {α : Sort*} {p : α → Sort*} [∀ x, subsingleton (p x)]
  {q : Π (x : α) (hx : p x), Prop} (h : ∃! x (hx : p x), q x hx)
  {y₁ y₂ : α} (hpy₁ : p y₁) (hqy₁ : q y₁ hpy₁)
  (hpy₂ : p y₂) (hqy₂ : q y₂ hpy₂) : y₁ = y₂ :=
begin
  simp only [exists_unique_iff_exists] at h,
  exact h.unique ⟨hpy₁, hqy₁⟩ ⟨hpy₂, hqy₂⟩
end

end quantifiers

namespace classical
variables {α : Sort*} {p : α → Prop}

theorem cases {p : Prop → Prop} (h1 : p true) (h2 : p false) : ∀a, p a :=
assume a, cases_on a h1 h2

noncomputable def dec (p : Prop) : decidable p :=
by apply_instance
noncomputable def dec_pred (p : α → Prop) : decidable_pred p :=
by apply_instance
noncomputable def dec_rel (p : α → α → Prop) : decidable_rel p :=
by apply_instance
noncomputable def dec_eq (α : Sort*) : decidable_eq α :=
by apply_instance

@[elab_as_eliminator]
noncomputable def {u} exists_cases {C : Sort u} (H0 : C) (H : ∀ a, p a → C) : C :=
if h : ∃ a, p a then H (classical.some h) (classical.some_spec h) else H0

lemma some_spec2 {α : Sort*} {p : α → Prop} {h : ∃a, p a}
  (q : α → Prop) (hpq : ∀a, p a → q a) : q (some h) :=
hpq _ $ some_spec _

noncomputable def subtype_of_exists {α : Type*} {P : α → Prop} (h : ∃ x, P x) : {x // P x} :=
⟨classical.some h, classical.some_spec h⟩

protected noncomputable def by_contradiction' {α : Sort*} (H : ¬ (α → false)) : α :=
classical.choice $ peirce _ false $ λ h, (H $ λ a, h ⟨a⟩).elim

def choice_of_by_contradiction' {α : Sort*} (contra : ¬ (α → false) → α) : nonempty α → α :=
λ H, contra H.elim

end classical

@[elab_as_eliminator]
noncomputable def {u} exists.classical_rec_on
{α} {p : α → Prop} (h : ∃ a, p a) {C : Sort u} (H : ∀ a, p a → C) : C :=
H (classical.some h) (classical.some_spec h)

section bounded_quantifiers
variables {α : Sort*} {r p q : α → Prop} {P Q : ∀ x, p x → Prop} {b : Prop}

theorem bex_def : (∃ x (h : p x), q x) ↔ ∃ x, p x ∧ q x :=
⟨λ ⟨x, px, qx⟩, ⟨x, px, qx⟩, λ ⟨x, px, qx⟩, ⟨x, px, qx⟩⟩

theorem bex.elim {b : Prop} : (∃ x h, P x h) → (∀ a h, P a h → b) → b
| ⟨a, h₁, h₂⟩ h' := h' a h₁ h₂

theorem bex.intro (a : α) (h₁ : p a) (h₂ : P a h₁) : ∃ x (h : p x), P x h :=
⟨a, h₁, h₂⟩

theorem ball_congr (H : ∀ x h, P x h ↔ Q x h) :
  (∀ x h, P x h) ↔ (∀ x h, Q x h) :=
forall_congr $ λ x, forall_congr (H x)

theorem bex_congr (H : ∀ x h, P x h ↔ Q x h) :
  (∃ x h, P x h) ↔ (∃ x h, Q x h) :=
exists_congr $ λ x, exists_congr (H x)

theorem bex_eq_left {a : α} : (∃ x (_ : x = a), p x) ↔ p a :=
by simp only [exists_prop, exists_eq_left]

theorem ball.imp_right (H : ∀ x h, (P x h → Q x h))
  (h₁ : ∀ x h, P x h) (x h) : Q x h :=
H _ _ $ h₁ _ _

theorem bex.imp_right (H : ∀ x h, (P x h → Q x h)) :
  (∃ x h, P x h) → ∃ x h, Q x h
| ⟨x, h, h'⟩ := ⟨_, _, H _ _ h'⟩

theorem ball.imp_left (H : ∀ x, p x → q x)
  (h₁ : ∀ x, q x → r x) (x) (h : p x) : r x :=
h₁ _ $ H _ h

theorem bex.imp_left (H : ∀ x, p x → q x) :
  (∃ x (_ : p x), r x) → ∃ x (_ : q x), r x
| ⟨x, hp, hr⟩ := ⟨x, H _ hp, hr⟩

theorem ball_of_forall (h : ∀ x, p x) (x) : p x :=
h x

theorem forall_of_ball (H : ∀ x, p x) (h : ∀ x, p x → q x) (x) : q x :=
h x $ H x

theorem bex_of_exists (H : ∀ x, p x) : (∃ x, q x) → ∃ x (_ : p x), q x
| ⟨x, hq⟩ := ⟨x, H x, hq⟩

theorem exists_of_bex : (∃ x (_ : p x), q x) → ∃ x, q x
| ⟨x, _, hq⟩ := ⟨x, hq⟩

@[simp] theorem bex_imp_distrib : ((∃ x h, P x h) → b) ↔ (∀ x h, P x h → b) :=
by simp

theorem not_bex : (¬ ∃ x h, P x h) ↔ ∀ x h, ¬ P x h :=
bex_imp_distrib

theorem not_ball_of_bex_not : (∃ x h, ¬ P x h) → ¬ ∀ x h, P x h
| ⟨x, h, hp⟩ al := hp $ al x h

protected theorem decidable.not_ball [decidable (∃ x h, ¬ P x h)] [∀ x h, decidable (P x h)] :
  (¬ ∀ x h, P x h) ↔ (∃ x h, ¬ P x h) :=
⟨not.decidable_imp_symm $ λ nx x h, nx.decidable_imp_symm $ λ h', ⟨x, h, h'⟩,
not_ball_of_bex_not⟩

theorem not_ball : (¬ ∀ x h, P x h) ↔ (∃ x h, ¬ P x h) := decidable.not_ball

theorem ball_true_iff (p : α → Prop) : (∀ x, p x → true) ↔ true :=
iff_true_intro (λ h hrx, trivial)

theorem ball_and_distrib : (∀ x h, P x h ∧ Q x h) ↔ (∀ x h, P x h) ∧ (∀ x h, Q x h) :=
iff.trans (forall_congr $ λ x, forall_and_distrib) forall_and_distrib

theorem bex_or_distrib : (∃ x h, P x h ∨ Q x h) ↔ (∃ x h, P x h) ∨ (∃ x h, Q x h) :=
iff.trans (exists_congr $ λ x, exists_or_distrib) exists_or_distrib

theorem ball_or_left_distrib : (∀ x, p x ∨ q x → r x) ↔ (∀ x, p x → r x) ∧ (∀ x, q x → r x) :=
iff.trans (forall_congr $ λ x, or_imp_distrib) forall_and_distrib

theorem bex_or_left_distrib :
  (∃ x (_ : p x ∨ q x), r x) ↔ (∃ x (_ : p x), r x) ∨ (∃ x (_ : q x), r x) :=
by simp only [exists_prop]; exact
iff.trans (exists_congr $ λ x, or_and_distrib_right) exists_or_distrib

end bounded_quantifiers

namespace classical
local attribute [instance] prop_decidable

theorem not_ball {α : Sort*} {p : α → Prop} {P : Π (x : α), p x → Prop} :
  (¬ ∀ x h, P x h) ↔ (∃ x h, ¬ P x h) := _root_.not_ball

end classical

section ite
variables {α β γ : Sort*} {σ : α → Sort*} (f : α → β) {P Q : Prop} [decidable P] [decidable Q]
  {a b c : α} {A : P → α} {B : ¬ P → α}

lemma dite_eq_iff : dite P A B = c ↔ (∃ h, A h = c) ∨ ∃ h, B h = c := by by_cases P; simp *
lemma ite_eq_iff : ite P a b = c ↔ P ∧ a = c ∨ ¬ P ∧ b = c :=
dite_eq_iff.trans $ by rw [exists_prop, exists_prop]

@[simp] lemma dite_eq_left_iff : dite P (λ _, a) B = a ↔ ∀ h, B h = a := by by_cases P; simp *
@[simp] lemma dite_eq_right_iff : dite P A (λ _, b) = b ↔ ∀ h, A h = b := by by_cases P; simp *
@[simp] lemma ite_eq_left_iff : ite P a b = a ↔ (¬ P → b = a) := dite_eq_left_iff
@[simp] lemma ite_eq_right_iff : ite P a b = b ↔ (P → a = b) := dite_eq_right_iff

lemma dite_ne_left_iff : dite P (λ _, a) B ≠ a ↔ ∃ h, a ≠ B h :=
by { rw [ne.def, dite_eq_left_iff, not_forall], exact exists_congr (λ h, by rw ne_comm) }

lemma dite_ne_right_iff : dite P A (λ _, b) ≠ b ↔ ∃ h, A h ≠ b :=
by simp only [ne.def, dite_eq_right_iff, not_forall]

lemma ite_ne_left_iff : ite P a b ≠ a ↔ ¬ P ∧ a ≠ b := dite_ne_left_iff.trans $ by rw exists_prop
lemma ite_ne_right_iff : ite P a b ≠ b ↔ P ∧ a ≠ b := dite_ne_right_iff.trans $ by rw exists_prop

protected lemma ne.dite_eq_left_iff (h : ∀ h, a ≠ B h) : dite P (λ _, a) B = a ↔ P :=
dite_eq_left_iff.trans $ ⟨λ H, of_not_not $ λ h', h h' (H h').symm, λ h H, (H h).elim⟩

protected lemma ne.dite_eq_right_iff (h : ∀ h, A h ≠ b) : dite P A (λ _, b) = b ↔ ¬ P :=
dite_eq_right_iff.trans $ ⟨λ H h', h h' (H h'), λ h' H, (h' H).elim⟩

protected lemma ne.ite_eq_left_iff (h : a ≠ b) : ite P a b = a ↔ P := ne.dite_eq_left_iff $ λ _, h
protected lemma ne.ite_eq_right_iff (h : a ≠ b) : ite P a b = b ↔ ¬ P :=
ne.dite_eq_right_iff $ λ _, h

protected lemma ne.dite_ne_left_iff (h : ∀ h, a ≠ B h) : dite P (λ _, a) B ≠ a ↔ ¬ P :=
dite_ne_left_iff.trans $ exists_iff_of_forall h

protected lemma ne.dite_ne_right_iff (h : ∀ h, A h ≠ b) : dite P A (λ _, b) ≠ b ↔ P :=
dite_ne_right_iff.trans $ exists_iff_of_forall h

protected lemma ne.ite_ne_left_iff (h : a ≠ b) : ite P a b ≠ a ↔ ¬ P := ne.dite_ne_left_iff $ λ _, h

protected lemma ne.ite_ne_right_iff (h : a ≠ b) : ite P a b ≠ b ↔ P := ne.dite_ne_right_iff $ λ _, h

variables (P Q) (a b)

@[simp] lemma dite_eq_ite : dite P (λ h, a) (λ h, b) = ite P a b := rfl

lemma dite_eq_or_eq : (∃ h, dite P A B = A h) ∨ ∃ h, dite P A B = B h :=
decidable.by_cases (λ h, or.inl ⟨h, dif_pos h⟩) (λ h, or.inr ⟨h, dif_neg h⟩)

lemma ite_eq_or_eq : ite P a b = a ∨ ite P a b = b :=
decidable.by_cases (λ h, or.inl (if_pos h)) (λ h, or.inr (if_neg h))

lemma apply_dite (x : P → α) (y : ¬P → α) : f (dite P x y) = dite P (λ h, f (x h)) (λ h, f (y h)) :=
by by_cases h : P; simp [h]

lemma apply_ite : f (ite P a b) = ite P (f a) (f b) := apply_dite f P (λ _, a) (λ _, b)

lemma apply_dite2 (f : α → β → γ) (P : Prop) [decidable P] (a : P → α) (b : ¬P → α) (c : P → β)
  (d : ¬P → β) :
  f (dite P a b) (dite P c d) = dite P (λ h, f (a h) (c h)) (λ h, f (b h) (d h)) :=
by by_cases h : P; simp [h]

lemma apply_ite2 (f : α → β → γ) (P : Prop) [decidable P] (a b : α) (c d : β) :
  f (ite P a b) (ite P c d) = ite P (f a c) (f b d) :=
apply_dite2 f P (λ _, a) (λ _, b) (λ _, c) (λ _, d)

lemma dite_apply (f : P → Π a, σ a) (g : ¬ P → Π a, σ a) (a : α) :
  (dite P f g) a = dite P (λ h, f h a) (λ h, g h a) :=
by by_cases h : P; simp [h]

lemma ite_apply (f g : Π a, σ a) (a : α) : (ite P f g) a = ite P (f a) (g a) :=
dite_apply P (λ _, f) (λ _, g) a

@[simp] lemma dite_not (x : ¬ P → α) (y : ¬¬ P → α) :
  dite (¬ P) x y = dite P (λ h, y (not_not_intro h)) x :=
by by_cases h : P; simp [h]

@[simp] lemma ite_not : ite (¬ P) a b = ite P b a := dite_not P (λ _, a) (λ _, b)

lemma ite_and : ite (P ∧ Q) a b = ite P (ite Q a b) b :=
by by_cases hp : P; by_cases hq : Q; simp [hp, hq]

end


/-
import Std.Data.HashSet
import Std.Data.AssocList
/-
TODO: ステップの進行時に誘発型能力の誘発をできるようにする．
置換型能力を取り扱うため，eventキューを用意し，ゲーム内の行動は一旦このキューにエンキューされる．
  置換型能力は置換するイベントと置換後のイベントで表される．
  ある状態での置換型能力の集合を用意しておき，eventキューの先端のイベントでその集合にfilterし対応する置換型能力を適用する
  置換型能力に置換する優先度を定義するが，同じ場合はここにユーザーの選択が入る
  「禁止する」効果は「何もしない」に置換する置換型効果として扱い，最も高い優先度を持つ．
ステップを開始するときの置換型能力と誘発型能力をどうするか決めてないね
ループの扱い
  ある状態である行動をしたときに何らかの能力（群）が生成され，ユーザが行動する前に同じ能力が有限個の違いを除いた状態s1とs2で生成されたとき，無限ループとする．
  ↑に加えてユーザの行動が入る場合，「前回と同じ行動をする」という前提を加えれば無限ループになるとき，ループとする．
  ループが存在するとき，有限回後にユーザの行動を変化させなければならない．
  基本的に能力は強制効果「〜する」であり，無限ループになるときに限りしないことを選択できる．
  任意効果「してもよい」がループを形成する場合，↑に準ずる．
  ループを形成する場合，有限個の違いを変数化して一気に処理したいが厳しそう
-/
inductive Player: Type
| player₁
| player₂
| player₃
| player₄
deriving DecidableEq
open Player
instance : Inhabited Player where default := player₁
def NextPlayerType := ∃f: Player → Player, ∀p: Player, ¬f p = p
def NextPlayerType.default: NextPlayerType := by {
  let f
  | player₁ => player₂
  | player₂ => player₃
  | player₃ => player₄
  | player₄ => player₁
  exists f;
  intro p';
  cases p';
  all_goals {
    intro;
    contradiction;
  }
}
instance : Inhabited NextPlayerType where default := NextPlayerType.default
def PlayerToNat: Player → Nat
| player₁ => 0
| player₂ => 1
| player₃ => 2
| player₄ => 3

inductive BeginningPhase: Type
| untap -- MEMO: namae kaeru yotei
| upkeep
| draw
open BeginningPhase

inductive CombatPhase: Type
| beginningOfCombat
| declareAtackers
| declareBlockers
| combatDamage
| endOfCombat
open CombatPhase

inductive EndingPhase: Type
| ending
| cleanup
open EndingPhase

inductive Phase: Type
| beginning (step: BeginningPhase)
| main
| combat (step: CombatPhase)
| ending (step: EndingPhase)
open Phase
def defaultBeginningPhase := [
  beginning untap,
  beginning upkeep,
  beginning draw
]
def defaultCombatPhase := [
  combat beginningOfCombat,
  combat declareAtackers,
  combat declareBlockers,
  combat combatDamage,
  combat endOfCombat
]
def defaultEndingPhase := [
  ending ending,
  ending cleanup
]

def TurnList := List Player
  deriving Inhabited
def PhaseList := List Phase
  deriving Inhabited
def defaultPhaseList :=
  defaultBeginningPhase
  ++ [main]
  ++ defaultCombatPhase
  ++ [main]
  ++ defaultEndingPhase

structure GameSetting where
  joinedPlayers: Std.AssocList Player Bool
  nextplayer: NextPlayerType
def GameSetting.default: GameSetting := {
    joinedPlayers:=
      Std.AssocList.empty
      |> Std.AssocList.cons player₁ true
      |> Std.AssocList.cons player₂ true
      |> Std.AssocList.cons player₃ true
      |> Std.AssocList.cons player₄ true,
      nextplayer := NextPlayerType.default,
  }
instance : Inhabited GameSetting where
  default := GameSetting.default
abbrev Zone := Std.HashSet Nat
structure PlayerState where
  hand: Zone
  deck: Zone
  --life: Int
  --graveyard: Zone
  --pool: Int
  passPriority: Bool
def PlayerState.default: PlayerState := {
  hand := Inhabited.default,
  deck := Inhabited.default,
  --life: Int
  --graveyard: Zone
  --pool: Int
  passPriority := false
}
instance : Inhabited PlayerState where
  default := PlayerState.default

structure PlayerStateStore where
  p₁: PlayerState
  p₂: PlayerState
  p₃: PlayerState
  p₄: PlayerState
def PlayerStateStore.default: PlayerStateStore := {
  p₁:= PlayerState.default,
  p₂:= PlayerState.default,
  p₃:= PlayerState.default,
  p₄:= PlayerState.default,
}
instance : Inhabited PlayerStateStore where
  default := PlayerStateStore.default

def UpdatePlayerStateStore (st: PlayerStateStore) (idx: Player) (ps: PlayerState): PlayerStateStore :=
  match idx with
  | player₁ => {st with p₁ := ps}
  | player₂ => {st with p₂ := ps}
  | player₃ => {st with p₃ := ps}
  | player₄ => {st with p₄ := ps}
def PlayerStateStore.getOp (self: PlayerStateStore) (idx: Player) : PlayerState :=
  match idx with
  | player₁ => self.p₁
  | player₂ => self.p₂
  | player₃ => self.p₃
  | player₄ => self.p₄
notation:100 st "[ " pl " ↦ " ps " ]" => UpdatePlayerStateStore st pl ps

inductive PriorityOwner
| none
| player(p: Player)
--deriving Inhabited
--honto ha default wo none ni sinaito ikenai
instance : Inhabited PriorityOwner where
  default := PriorityOwner.player player₁

structure GameState where
  setting: GameSetting
  turnList: TurnList
  phaseList: PhaseList
  priority: PriorityOwner
  didEveryPlayerPassTheirPriority: Bool
  playerStates: PlayerStateStore
def GameState.default: GameState := {
  setting := Inhabited.default,
  turnList := [player₁],
  phaseList := defaultPhaseList,
  priority := Inhabited.default,
  didEveryPlayerPassTheirPriority := Inhabited.default,
  playerStates := Inhabited.default,
}

instance : Inhabited GameState where
  default := GameState.default

def updatePriority (ps: PlayerStateStore) (pl: Player) (p: Bool) :=
  ps[pl ↦ {ps[pl] with passPriority := p}]
def updateEveryPriority (ps: PlayerStateStore) (p: Bool) :=
  let ps₁ := updatePriority ps player₁ p;
  let ps₂ := updatePriority ps₁ player₂ p;
  let ps₃ := updatePriority ps₂ player₃ p;
  updatePriority ps₃ player₄ p

theorem preservePlayerState : ∀s p p' b, p ≠ p' → (updatePriority s p b)[p'] = s[p'] := by {
  intro s p p' b neq;
  cases p;
  all_goals cases p';
  all_goals try contradiction;
  all_goals simp [PlayerStateStore.getOp, updatePriority, UpdatePlayerStateStore];
}

--#check @Exists
--#check @Sigma

inductive PriorityRel: GameState → GameState → Prop
| passPriority: ∀(s: GameState) (p: Player),
  s.priority = PriorityOwner.player p ∧ s.playerStates[p].passPriority = false -- かつ ターン起因処理と誘発型能力を積み終わった
  → PriorityRel s
  {
    s with
    priority := PriorityOwner.player (s.setting.nextplayer.1 p),
    playerStates := updatePriority s.playerStates p true,
  } -- MEMO: koko motto iikannji ni sitai
| transPriority: ∀s₁ s₂ s₃,
  PriorityRel s₁ s₂
  → PriorityRel s₂ s₃
  → PriorityRel s₁ s₃
| everyPlayerPassTheirPriority: ∀(s: GameState) (p: Player) (tl: TurnList),
  s.priority = PriorityOwner.player p
  ∧ s.turnList = p :: tl
  ∧ (∀(p: Player),
    Std.AssocList.contains p s.setting.joinedPlayers
    ∧ Std.AssocList.find? p s.setting.joinedPlayers = some true
    ∧ s.playerStates[p].passPriority = true)
  → PriorityRel s
  {
    s with
    playerStates := updateEveryPriority s.playerStates false,
    didEveryPlayerPassTheirPriority := true,
  }
-- その他の行動をできるようにする

theorem proofOfPassPriority: ∀s p,
s.priority = (PriorityOwner.player p)
∧ s.playerStates[p].passPriority = false
→ ∃s', PriorityRel s s'
∧ s' = {
    s with
    priority := PriorityOwner.player (s.setting.nextplayer.1 p),
    playerStates := updatePriority s.playerStates p true,
  } := by
{
  intros s p h;
  let s' := {
    s with
    priority := PriorityOwner.player (s.setting.nextplayer.1 p),
    playerStates := updatePriority s.playerStates p true,
  };
  exists s';
  apply And.intro;
  exact (PriorityRel.passPriority s p h);
  rfl;
}

theorem proofOfEveryPlayerPassTheirPriority: ∀s p tl,
s.priority = PriorityOwner.player p
∧ s.turnList = p :: tl
∧ (∀(p: Player),
  Std.AssocList.contains p s.setting.joinedPlayers
  ∧ Std.AssocList.find? p s.setting.joinedPlayers = some true
  ∧ s.playerStates[p].passPriority = true)
→ ∃s', PriorityRel s s'
∧ s' = {
  s with
  playerStates := updateEveryPriority s.playerStates false,
  didEveryPlayerPassTheirPriority := true,
} := by {
  intros s p tl h1;
  let s' := {
    s with
    playerStates := updateEveryPriority s.playerStates false,
    didEveryPlayerPassTheirPriority := true,
    };
  exists s';
  apply And.intro;
  exact PriorityRel.everyPlayerPassTheirPriority s p tl h1;
  rfl;
}

inductive ProgressPhaseRel: GameState → GameState → Prop
| nextStep: ∀(s: GameState) (p: Phase) (next: PhaseList),
  s.phaseList = p::next ∧ s.didEveryPlayerPassTheirPriority = true
  → ProgressPhaseRel s {s with phaseList := next, didEveryPlayerPassTheirPriority := false}
  -- ターン起因処理と状況起因処理，誘発型能力の誘発をした状態にする
| transStep: ∀s₁ s₂ s₃,
  ProgressPhaseRel s₁ s₂
  → ProgressPhaseRel s₂ s₃
  → ProgressPhaseRel s₁ s₃
| priorityRel: ∀s₁ s₂ s₃,
  PriorityRel s₁ s₂
  → ProgressPhaseRel s₂ s₃
  → ProgressPhaseRel s₁ s₃

inductive ProgressTurnRel: GameState → GameState → Prop
| nextTurn:
  ∀ (s: GameState) (p: Player),
  s.turnList = [p] ∧ s.phaseList = []
  → ProgressTurnRel s {s with turnList := [s.setting.nextplayer.1 p], phaseList := defaultPhaseList}
  -- ターン起因処理と状況起因処理，誘発型能力の誘発をした状態にする．
-- | untapStep
-- アンタップ・ステップのターン起因処理関連はここで行わないといけない
| extraTurn:
  ∀ (s: GameState) (p : Player) (next: TurnList),
  ¬ next = []
  ∧ s.turnList = p::next ∧ s.phaseList = []
  → ProgressTurnRel s {s with turnList := next, phaseList := defaultPhaseList}
| transTurn: ∀s₁ s₂ s₃,
  ProgressTurnRel s₁ s₂
  → ProgressTurnRel s₂ s₃
  → ProgressTurnRel s₁ s₃
| phaseRel: ∀s₁ s₂ s₃,
  ProgressPhaseRel s₁ s₂
  → ProgressTurnRel s₂ s₃
  → ProgressTurnRel s₁ s₃

--#print List

example : ProgressTurnRel GameState.default {GameState.default with turnList := [player₂]} := by {
  let s: GameState := GameState.default;
  have h0: s = GameState.default := rfl;
  have h1: s.turnList = [player₁] := rfl;
  have h2: s.priority = PriorityOwner.player player₁ := rfl;
  have h3: s.playerStates[player₁].passPriority = false := rfl;
  rw [h0] at *;
  have ⟨s1, ⟨h4, h5⟩⟩ := proofOfPassPriority s player₁ (And.intro h2 h3);

}
-/


/-
Copyright (c) 2019 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Sebastian Ullrich
-/
import Lean.Parser.Term
import Lean.Parser.Do

namespace Lean
namespace Parser

/--
  Syntax quotation for terms and (lists of) commands. We prefer terms, so ambiguous quotations like
  `` `($x $y) `` will be parsed as an application, not two commands. Use `` `($x:command $y:command) `` instead.
  Multiple command will be put in a `` `null `` node, but a single command will not (so that you can directly
  match against a quotation in a command kind's elaborator). -/
-- TODO: use two separate quotation parsers with parser priorities instead
@[builtinTermParser] def Term.quot := leading_parser "`(" >> incQuotDepth (termParser <|> many1Unbox commandParser) >> ")"
@[builtinTermParser] def Term.precheckedQuot := leading_parser "`" >> Term.quot

namespace Command

/--
  A mutual block may be broken in different cliques, we identify them using an `ident` (an element of the clique)
  We provide two kinds of hints to the termination checker:
  1- A wellfounded relation (`p` is `termParser`)
  2- A tactic for proving the recursive applications are "decreasing" (`p` is `tacticSeq`)
-/
def terminationHintMany (p : Parser) := leading_parser atomic (lookahead (ident >> " => ")) >> many1Indent (group (ppLine >> ident >> " => " >> p >> optional ";"))
def terminationHint1 (p : Parser) := leading_parser p
def terminationHint (p : Parser) := terminationHintMany p <|> terminationHint1 p

def terminationByCore := leading_parser "termination_by' " >> terminationHint termParser
def decreasingBy := leading_parser "decreasing_by " >> terminationHint Tactic.tacticSeq

def terminationByElement   := leading_parser ppLine >> (ident <|> "_") >> many (ident <|> "_") >> " => " >> termParser >> optional ";"
def terminationBy          := leading_parser ppLine >> "termination_by " >> many1Indent terminationByElement

def terminationSuffix := optional (terminationBy <|> terminationByCore) >> optional decreasingBy

@[builtinCommandParser]
def moduleDoc := leading_parser ppDedent $ "/-!" >> commentBody >> ppLine

def namedPrio := leading_parser (atomic ("(" >> nonReservedSymbol "priority") >> " := " >> priorityParser >> ")")
def optNamedPrio := optional (ppSpace >> namedPrio)

def «private»        := leading_parser "private "
def «protected»      := leading_parser "protected "
def visibility       := «private» <|> «protected»
def «noncomputable»  := leading_parser "noncomputable "
def «unsafe»         := leading_parser "unsafe "
def «partial»        := leading_parser "partial "
def «nonrec»         := leading_parser "nonrec "
def declModifiers (inline : Bool) := leading_parser optional docComment >> optional (Term.«attributes» >> if inline then skip else ppDedent ppLine) >> optional visibility >> optional «noncomputable» >> optional «unsafe» >> optional («partial» <|> «nonrec»)
def declId           := leading_parser ident >> optional (".{" >> sepBy1 ident ", " >> "}")
def declSig          := leading_parser many (ppSpace >> (Term.simpleBinderWithoutType <|> Term.bracketedBinder)) >> Term.typeSpec
def optDeclSig       := leading_parser many (ppSpace >> (Term.simpleBinderWithoutType <|> Term.bracketedBinder)) >> Term.optType
def declValSimple    := leading_parser " :=" >> ppHardLineUnlessUngrouped >> termParser >> optional Term.whereDecls
def declValEqns      := leading_parser Term.matchAltsWhereDecls
def whereStructField := leading_parser Term.letDecl
def whereStructInst  := leading_parser " where" >> many1Indent (ppLine >> ppGroup (group (whereStructField >> optional ";")))
/-
  Remark: we should not use `Term.whereDecls` at `declVal` because `Term.whereDecls` is defined using `Term.letRecDecl` which may contain attributes.
  Issue #753 showns an example that fails to be parsed when we used `Term.whereDecls`.
-/
def declVal          := declValSimple <|> declValEqns <|> whereStructInst
def «abbrev»         := leading_parser "abbrev " >> declId >> ppIndent optDeclSig >> declVal
def optDefDeriving   := optional (atomic ("deriving " >> notSymbol "instance") >> sepBy1 ident ", ")
def «def»            := leading_parser "def " >> declId >> ppIndent optDeclSig >> declVal >> optDefDeriving >> terminationSuffix
def «theorem»        := leading_parser "theorem " >> declId >> ppIndent declSig >> declVal >> terminationSuffix
def «constant»       := leading_parser "constant " >> declId >> ppIndent declSig >> optional declValSimple
/- As `declSig` starts with a space, "instance" does not need a trailing space if we put `ppSpace` in the optional fragments. -/
def «instance»       := leading_parser Term.attrKind >> "instance" >> optNamedPrio >> optional (ppSpace >> declId) >> ppIndent declSig >> declVal >> terminationSuffix
def «axiom»          := leading_parser "axiom " >> declId >> ppIndent declSig
/- As `declSig` starts with a space, "example" does not need a trailing space. -/
def «example»        := leading_parser "example" >> ppIndent declSig >> declVal
def inferMod         := leading_parser ppSpace >> atomic (symbol "{" >> "}")
def ctor             := leading_parser "\n| " >> ppIndent (declModifiers true >> ident >> optional inferMod >> optDeclSig)
def derivingClasses  := sepBy1 (group (ident >> optional (" with " >> Term.structInst))) ", "
def optDeriving      := leading_parser optional (ppLine >> atomic ("deriving " >> notSymbol "instance") >> derivingClasses)
def «inductive»      := leading_parser "inductive " >> declId >> optDeclSig >> optional (symbol " :=" <|> " where") >> many ctor >> optDeriving
def classInductive   := leading_parser atomic (group (symbol "class " >> "inductive ")) >> declId >> ppIndent optDeclSig >> optional (symbol " :=" <|> " where") >> many ctor >> optDeriving
def structExplicitBinder := leading_parser atomic (declModifiers true >> "(") >> many1 ident >> optional inferMod >> ppIndent optDeclSig >> optional (Term.binderTactic <|> Term.binderDefault) >> ")"
def structImplicitBinder := leading_parser atomic (declModifiers true >> "{") >> many1 ident >> optional inferMod >> declSig >> "}"
def structInstBinder     := leading_parser atomic (declModifiers true >> "[") >> many1 ident >> optional inferMod >> declSig >> "]"
def structSimpleBinder   := leading_parser atomic (declModifiers true >> ident) >> optional inferMod >> optDeclSig >> optional (Term.binderTactic <|> Term.binderDefault)
def structFields         := leading_parser manyIndent (ppLine >> checkColGe >> ppGroup (structExplicitBinder <|> structImplicitBinder <|> structInstBinder <|> structSimpleBinder))
def structCtor           := leading_parser atomic (declModifiers true >> ident >> optional inferMod >> " :: ")
def structureTk          := leading_parser "structure "
def classTk              := leading_parser "class "
def «extends»            := leading_parser " extends " >> sepBy1 termParser ", "
def «structure»          := leading_parser
    (structureTk <|> classTk) >> declId >> many (ppSpace >> Term.bracketedBinder) >> optional «extends» >> Term.optType
    >> optional ((symbol " := " <|> " where ") >> optional structCtor >> structFields)
    >> optDeriving
@[builtinCommandParser] def declaration := leading_parser
declModifiers false >> («abbrev» <|> «def» <|> «theorem» <|> «constant» <|> «instance» <|> «axiom» <|> «example» <|> «inductive» <|> classInductive <|> «structure»)
@[builtinCommandParser] def «deriving»     := leading_parser "deriving " >> "instance " >> derivingClasses >> " for " >> sepBy1 ident ", "
@[builtinCommandParser] def noncomputableSection := leading_parser "noncomputable " >> "section " >> optional ident
@[builtinCommandParser] def «section»      := leading_parser "section " >> optional ident
@[builtinCommandParser] def «namespace»    := leading_parser "namespace " >> ident
@[builtinCommandParser] def «end»          := leading_parser "end " >> optional ident
@[builtinCommandParser] def «variable»     := leading_parser "variable" >> many1 (ppSpace >> Term.bracketedBinder)
@[builtinCommandParser] def «universe»     := leading_parser "universe " >> many1 ident
@[builtinCommandParser] def check          := leading_parser "#check " >> termParser
@[builtinCommandParser] def check_failure  := leading_parser "#check_failure " >> termParser -- Like `#check`, but succeeds only if term does not type check
@[builtinCommandParser] def reduce         := leading_parser "#reduce " >> termParser
@[builtinCommandParser] def eval           := leading_parser "#eval " >> termParser
@[builtinCommandParser] def synth          := leading_parser "#synth " >> termParser
@[builtinCommandParser] def exit           := leading_parser "#exit"
@[builtinCommandParser] def print          := leading_parser "#print " >> (ident <|> strLit)
@[builtinCommandParser] def printAxioms    := leading_parser "#print " >> nonReservedSymbol "axioms " >> ident
@[builtinCommandParser] def «resolve_name» := leading_parser "#resolve_name " >> ident
@[builtinCommandParser] def «init_quot»    := leading_parser "init_quot"
def optionValue := nonReservedSymbol "true" <|> nonReservedSymbol "false" <|> strLit <|> numLit
@[builtinCommandParser] def «set_option»   := leading_parser "set_option " >> ident >> ppSpace >> optionValue
def eraseAttr := leading_parser "-" >> rawIdent
@[builtinCommandParser] def «attribute»    := leading_parser "attribute " >> "[" >> sepBy1 (eraseAttr <|> Term.attrInstance) ", " >> "] " >> many1 ident
@[builtinCommandParser] def «export»       := leading_parser "export " >> ident >> " (" >> many1 ident >> ")"
def openHiding       := leading_parser atomic (ident >> "hiding") >> many1 (checkColGt >> ident)
def openRenamingItem := leading_parser ident >> unicodeSymbol " → " " -> " >> checkColGt >> ident
def openRenaming     := leading_parser atomic (ident >> "renaming") >> sepBy1 openRenamingItem ", "
def openOnly         := leading_parser atomic (ident >> " (") >> many1 ident >> ")"
def openSimple       := leading_parser many1 (checkColGt >> ident)
def openScoped       := leading_parser "scoped " >> many1 (checkColGt >> ident)
def openDecl         := openHiding <|> openRenaming <|> openOnly <|> openSimple <|> openScoped
@[builtinCommandParser] def «open»    := leading_parser withPosition ("open " >> openDecl)

@[builtinCommandParser] def «mutual» := leading_parser "mutual " >> many1 (ppLine >> notSymbol "end" >> commandParser) >> ppDedent (ppLine >> "end") >> terminationSuffix
@[builtinCommandParser] def «initialize» := leading_parser optional visibility >> "initialize " >> optional (atomic (ident >> Term.typeSpec >> Term.leftArrow)) >> Term.doSeq
@[builtinCommandParser] def «builtin_initialize» := leading_parser optional visibility >> "builtin_initialize " >> optional (atomic (ident >> Term.typeSpec >> Term.leftArrow)) >> Term.doSeq

@[builtinCommandParser] def «in»  := trailing_parser withOpen (" in " >> commandParser)

/-
  This is an auxiliary command for generation constructor injectivity theorems for inductive types defined at `Prelude.lean`.
  It is meant for bootstrapping purposes only. -/
@[builtinCommandParser] def genInjectiveTheorems := leading_parser "gen_injective_theorems% " >> ident

@[runBuiltinParserAttributeHooks] abbrev declModifiersF := declModifiers false
@[runBuiltinParserAttributeHooks] abbrev declModifiersT := declModifiers true

builtin_initialize
  register_parser_alias "declModifiers"       declModifiersF
  register_parser_alias "nestedDeclModifiers" declModifiersT
  register_parser_alias                       declId
  register_parser_alias                       declSig
  register_parser_alias                       declVal
  register_parser_alias                       optDeclSig
  register_parser_alias                       openDecl

end Command

namespace Term
@[builtinTermParser] def «open» := leading_parser:leadPrec "open " >> Command.openDecl >> withOpenDecl (" in " >> termParser)
@[builtinTermParser] def «set_option» := leading_parser:leadPrec "set_option " >> ident >> ppSpace >> Command.optionValue >> " in " >> termParser
end Term

namespace Tactic
@[builtinTacticParser] def «open» := leading_parser:leadPrec "open " >> Command.openDecl >> withOpenDecl (" in " >> tacticSeq)
@[builtinTacticParser] def «set_option» := leading_parser:leadPrec "set_option " >> ident >> ppSpace >> Command.optionValue >> " in " >> tacticSeq
end Tactic

end Parser
end Lean


/-
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.Util.FindMVar
import Lean.Meta.SynthInstance
import Lean.Meta.CollectMVars
import Lean.Meta.Tactic.Util

namespace Lean.Meta
/-- Controls which new mvars are turned in to goals by the `apply` tactic.
- `nonDependentFirst`  mvars that don't depend on other goals appear first in the goal list.
- `nonDependentOnly` only mvars that don't depend on other goals are added to goal list.
- `all` all unassigned mvars are added to the goal list.
-/
inductive ApplyNewGoals where
  | nonDependentFirst | nonDependentOnly | all

/-- Configures the behaviour of the `apply` tactic. -/
structure ApplyConfig where
  newGoals := ApplyNewGoals.nonDependentFirst
  /--
  If `synthAssignedInstances` is `true`, then `apply` will synthesize instance implicit arguments
  even if they have assigned by `isDefEq`, and then check whether the synthesized value matches the
  one inferred. The `congr` tactic sets this flag to false.
  -/
  synthAssignedInstances := true
  /--
  If `approx := true`, then we turn on `isDefEq` approximations. That is, we use
  the `approxDefEq` combinator.
  -/
  approx : Bool := true

/--
  Compute the number of expected arguments and whether the result type is of the form
  (?m ...) where ?m is an unassigned metavariable.
-/
def getExpectedNumArgsAux (e : Expr) : MetaM (Nat × Bool) :=
  withDefault <| forallTelescopeReducing e fun xs body =>
    pure (xs.size, body.getAppFn.isMVar)

def getExpectedNumArgs (e : Expr) : MetaM Nat := do
  let (numArgs, _) ← getExpectedNumArgsAux e
  pure numArgs

private def throwApplyError {α} (mvarId : MVarId) (eType : Expr) (targetType : Expr) : MetaM α :=
  throwTacticEx `apply mvarId m!"failed to unify{indentExpr eType}\nwith{indentExpr targetType}"

def synthAppInstances (tacticName : Name) (mvarId : MVarId) (newMVars : Array Expr) (binderInfos : Array BinderInfo) (synthAssignedInstances : Bool) : MetaM Unit :=
  newMVars.size.forM fun i => do
    if binderInfos[i]!.isInstImplicit then
      let mvar := newMVars[i]!
      if synthAssignedInstances || !(← mvar.mvarId!.isAssigned) then
        let mvarType ← inferType mvar
        let mvarVal  ← synthInstance mvarType
        unless (← isDefEq mvar mvarVal) do
          throwTacticEx tacticName mvarId "failed to assign synthesized instance"

def appendParentTag (mvarId : MVarId) (newMVars : Array Expr) (binderInfos : Array BinderInfo) : MetaM Unit := do
  let parentTag ← mvarId.getTag
  if newMVars.size == 1 then
    -- if there is only one subgoal, we inherit the parent tag
    newMVars[0]!.mvarId!.setTag parentTag
  else
    unless parentTag.isAnonymous do
      newMVars.size.forM fun i => do
        let mvarIdNew := newMVars[i]!.mvarId!
        unless (← mvarIdNew.isAssigned) do
          unless binderInfos[i]!.isInstImplicit do
            let currTag ← mvarIdNew.getTag
            mvarIdNew.setTag (appendTag parentTag currTag)

/--
If `synthAssignedInstances` is `true`, then `apply` will synthesize instance implicit arguments
even if they have assigned by `isDefEq`, and then check whether the synthesized value matches the
one inferred. The `congr` tactic sets this flag to false.
-/
def postprocessAppMVars (tacticName : Name) (mvarId : MVarId) (newMVars : Array Expr) (binderInfos : Array BinderInfo) (synthAssignedInstances := true) : MetaM Unit := do
  synthAppInstances tacticName mvarId newMVars binderInfos synthAssignedInstances
  -- TODO: default and auto params
  appendParentTag mvarId newMVars binderInfos

private def dependsOnOthers (mvar : Expr) (otherMVars : Array Expr) : MetaM Bool :=
  otherMVars.anyM fun otherMVar => do
    if mvar == otherMVar then
      return false
    else
      let otherMVarType ← inferType otherMVar
      return (otherMVarType.findMVar? fun mvarId => mvarId == mvar.mvarId!).isSome

/-- Partitions the given mvars in to two arrays (non-deps, deps)
according to whether the given mvar depends on other mvars in the array.-/
private def partitionDependentMVars (mvars : Array Expr) : MetaM (Array MVarId × Array MVarId) :=
  mvars.foldlM (init := (#[], #[])) fun (nonDeps, deps) mvar => do
    let currMVarId := mvar.mvarId!
    if (← dependsOnOthers mvar mvars) then
      return (nonDeps, deps.push currMVarId)
    else
      return (nonDeps.push currMVarId, deps)

private def reorderGoals (mvars : Array Expr) : ApplyNewGoals → MetaM (List MVarId)
  | ApplyNewGoals.nonDependentFirst => do
      let (nonDeps, deps) ← partitionDependentMVars mvars
      return nonDeps.toList ++ deps.toList
  | ApplyNewGoals.nonDependentOnly => do
      let (nonDeps, _) ← partitionDependentMVars mvars
      return nonDeps.toList
  | ApplyNewGoals.all => return mvars.toList.map Lean.Expr.mvarId!

/-- Custom `isDefEq` for the `apply` tactic -/
private def isDefEqApply (cfg : ApplyConfig) (a b : Expr) : MetaM Bool := do
  if cfg.approx then
    approxDefEq <| isDefEqGuarded a b
  else
    isDefEqGuarded a b

/--
Close the given goal using `apply e`.
-/
def _root_.Lean.MVarId.apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig := {}) : MetaM (List MVarId) :=
  mvarId.withContext do
    mvarId.checkNotAssigned `apply
    let targetType ← mvarId.getType
    let eType      ← inferType e
    let (numArgs, hasMVarHead) ← getExpectedNumArgsAux eType
    /-
    The `apply` tactic adds `_`s to `e`, and some of these `_`s become new goals.
    When `hasMVarHead` is `false` we try different numbers, until we find a type compatible with `targetType`.
    We used to try only `numArgs-targetTypeNumArgs` when `hasMVarHead = false`, but this is not always correct.
    For example, consider the following example
    ```
    example {α β} [LE_trans β] (x y z : α → β) (h₀ : x ≤ y) (h₁ : y ≤ z) : x ≤ z := by
      apply le_trans
      assumption
      assumption
    ```
    In this example, `targetTypeNumArgs = 1` because `LE` for functions is defined as
    ```
    instance {α : Type u} {β : Type v} [LE β] : LE (α → β) where
      le f g := ∀ i, f i ≤ g i
    ```
    -/
    let rangeNumArgs ← if hasMVarHead then
      pure [numArgs : numArgs+1]
    else
      let targetTypeNumArgs ← getExpectedNumArgs targetType
      pure [numArgs - targetTypeNumArgs : numArgs+1]
    /-
    Auxiliary function for trying to add `n` underscores where `n ∈ [i: rangeNumArgs.stop)`
    See comment above
    -/
    let rec go (i : Nat) : MetaM (Array Expr × Array BinderInfo) := do
      if i < rangeNumArgs.stop then
        let s ← saveState
        let (newMVars, binderInfos, eType) ← forallMetaTelescopeReducing eType i
        if (← isDefEqApply cfg eType targetType) then
          return (newMVars, binderInfos)
        else
          s.restore
          go (i+1)
      else
        let (_, _, eType) ← forallMetaTelescopeReducing eType (some rangeNumArgs.start)
        throwApplyError mvarId eType targetType
    let (newMVars, binderInfos) ← go rangeNumArgs.start
    postprocessAppMVars `apply mvarId newMVars binderInfos cfg.synthAssignedInstances
    let e ← instantiateMVars e
    mvarId.assign (mkAppN e newMVars)
    let newMVars ← newMVars.filterM fun mvar => not <$> mvar.mvarId!.isAssigned
    let otherMVarIds ← getMVarsNoDelayed e
    let newMVarIds ← reorderGoals newMVars cfg.newGoals
    let otherMVarIds := otherMVarIds.filter fun mvarId => !newMVarIds.contains mvarId
    let result := newMVarIds ++ otherMVarIds.toList
    result.forM (·.headBetaType)
    return result
termination_by go i => rangeNumArgs.stop - i

@[deprecated MVarId.apply]
def apply (mvarId : MVarId) (e : Expr) (cfg : ApplyConfig := {}) : MetaM (List MVarId) :=
  mvarId.apply e cfg

partial def splitAndCore (mvarId : MVarId) : MetaM (List MVarId) :=
  mvarId.withContext do
    mvarId.checkNotAssigned `splitAnd
    let type ← mvarId.getType'
    if !type.isAppOfArity ``And 2 then
      return [mvarId]
    else
      let tag ← mvarId.getTag
      let rec go (type : Expr) : StateRefT (Array MVarId) MetaM Expr := do
        let type ← whnf type
        if type.isAppOfArity ``And 2 then
          let p₁ := type.appFn!.appArg!
          let p₂ := type.appArg!
          return mkApp4 (mkConst ``And.intro) p₁ p₂ (← go p₁) (← go p₂)
        else
          let idx := (← get).size + 1
          let mvar ← mkFreshExprSyntheticOpaqueMVar type (tag ++ (`h).appendIndexAfter idx)
          modify fun s => s.push mvar.mvarId!
          return mvar
      let (val, s) ← go type |>.run #[]
      mvarId.assign val
      return s.toList

/--
Apply `And.intro` as much as possible to goal `mvarId`.
-/
abbrev _root_.Lean.MVarId.splitAnd (mvarId : MVarId) : MetaM (List MVarId) :=
  splitAndCore mvarId

@[deprecated MVarId.splitAnd]
def splitAnd (mvarId : MVarId) : MetaM (List MVarId) :=
  mvarId.splitAnd

def _root_.Lean.MVarId.exfalso (mvarId : MVarId) : MetaM MVarId :=
  mvarId.withContext do
    mvarId.checkNotAssigned `exfalso
    let target ← instantiateMVars (← mvarId.getType)
    let u ← getLevel target
    let mvarIdNew ← mkFreshExprSyntheticOpaqueMVar (mkConst ``False) (tag := (← mvarId.getTag))
    mvarId.assign (mkApp2 (mkConst ``False.elim [u]) target mvarIdNew)
    return mvarIdNew.mvarId!

end Lean.Meta