import tactic.basic
import tactic.linarith
import tactic.suggest

namespace lambda_calculus

variables {α: Type*}
variables {a b c: α}
variables {n m nm: ℕ}
variables {r: α → α → Prop}

def distance_le (r: α → α → Prop): ℕ → α → α → Prop
| 0 := λ f g, f = g
| (n+1) := λ f g, distance_le n f g ∨ ∃ x, (r f x ∨ r x f) ∧ distance_le n x g

theorem distance_le_zero (r: α → α → Prop): distance_le r 0 a b ↔ a = b := by simp[distance_le]

theorem distance_le_refl (a: α): distance_le r 0 a a := by rw[distance_le_zero]

theorem distance_le_one: distance_le r 1 a b ↔ (a = b ∨ r a b ∨ r b a) :=
by simp[distance_le]

theorem distance_le_single: r a b → distance_le r 1 a b :=
by { intro p, simp[distance_le_one, p] }

theorem distance_le_single': r b a → distance_le r 1 a b :=
by { intro p, simp[distance_le_one, p] }

theorem distance_le_succ: distance_le r n a b → distance_le r (n+1) a b :=
by { intro p, simp [distance_le, p] }

theorem distance_le_mono: distance_le r n a b → n ≤ m → distance_le r m a b :=
begin
  induction m generalizing n,
  { simp,
    intros _ hn,
    rw [← hn],
    assumption },
  { intros p hnm,
    cases eq_or_lt_of_le hnm,
    { rw [← h], assumption },
    exact distance_le_succ (m_ih p (nat.le_of_lt_succ h)) }
end

theorem distance_le_mono': n ≤ m → distance_le r n a b → distance_le r m a b :=
  λ p q, distance_le_mono q p

theorem distance_le_head: distance_le r (n+1) a b → ∃ f, distance_le r 1 a f ∧ distance_le r n f b :=
begin
  simp [distance_le],
  intro hx,
  cases hx,
  { exact ⟨a, or.inl rfl, hx⟩ },
  cases hx with x hx,
  exact ⟨x, or.inr hx.left, hx.right ⟩,
end

theorem distance_le_trans: distance_le r n a b → distance_le r m b c → distance_le r (n+m) a c :=
begin
  induction n generalizing m a b c,
  all_goals { simp [distance_le, nat.succ_add] },
  { intro ab, simp [ab, nat.zero_add] },
  intros hx hbc,
  cases hx,
  { exact or.inl (n_ih hx hbc) },
  right,
  cases hx with x hx,
  exact ⟨x, hx.left, n_ih hx.right hbc⟩
end

theorem distance_le_trans' (n m: ℕ): distance_le r n a b → distance_le r m b c → n + m = nm → distance_le r nm a c :=
begin
  intros hab hbc hnm,
  rw ←hnm,
  apply distance_le_trans hab hbc
end

theorem distance_le_trans_sub (n m: ℕ):
  distance_le r n a b → distance_le r (m - n) b c → n ≤ m → distance_le r m a c :=
begin
  intros hab hbc hnm,
  apply distance_le_trans' _ _ hab hbc,
  rw [nat.add_comm],
  apply nat.sub_add_cancel hnm,
end

theorem distance_le_symm: distance_le r n a b → distance_le r n b a :=
begin
  induction n generalizing a b,
  { simp [distance_le],
    apply eq.symm },
  { intro p,
    cases distance_le_head p with x hfx,
    apply distance_le_trans' _ 1,
    apply n_ih hfx.right,
    simp [distance_le] at *,
    cases hfx.left with h,
    { simp [h] },
    cases h with h,
    repeat { simp[h] },
    simp },
end

theorem distance_le_cong (f: α → α):
  (∀ {x y}, r x y → r (f x) (f y)) → distance_le r n a b →
  distance_le r n (f a) (f b) :=
begin
  intro p,
  induction n generalizing a b,
  { simp [distance_le_zero],
    intro h,
    rw [h] },
  { intro h,
    rcases distance_le_head h with ⟨c, hac, hcb⟩,
    rw [nat.succ_eq_add_one, nat.add_comm],
    apply distance_le_trans _ (n_ih hcb),
    rw [distance_le_one] at hac,
    rw [distance_le_one],
    obtain hac|hac|hac := hac,
    { simp [hac] },
    repeat { simp [p hac] } }
end

end lambda_calculus


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov

! This file was ported from Lean 3 source module analysis.asymptotics.theta
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Asymptotics.Asymptotics

/-!
# Asymptotic equivalence up to a constant

In this file we define `asymptotics.is_Theta l f g` (notation: `f =Θ[l] g`) as
`f =O[l] g ∧ g =O[l] f`, then prove basic properties of this equivalence relation.
-/

open Filter

open Topology

namespace Asymptotics

variable {α : Type _} {β : Type _} {E : Type _} {F : Type _} {G : Type _} {E' : Type _}
  {F' : Type _} {G' : Type _} {E'' : Type _} {F'' : Type _} {G'' : Type _} {R : Type _}
  {R' : Type _} {𝕜 : Type _} {𝕜' : Type _}

variable [Norm E] [Norm F] [Norm G]

variable [SeminormedAddCommGroup E'] [SeminormedAddCommGroup F'] [SeminormedAddCommGroup G']
  [NormedAddCommGroup E''] [NormedAddCommGroup F''] [NormedAddCommGroup G''] [SeminormedRing R]
  [SeminormedRing R']

variable [NormedField 𝕜] [NormedField 𝕜']

variable {c c' c₁ c₂ : ℝ} {f : α → E} {g : α → F} {k : α → G}

variable {f' : α → E'} {g' : α → F'} {k' : α → G'}

variable {f'' : α → E''} {g'' : α → F''}

variable {l l' : Filter α}

/-- We say that `f` is `Θ(g)` along a filter `l` (notation: `f =Θ[l] g`) if `f =O[l] g` and
`g =O[l] f`. -/
def IsTheta (l : Filter α) (f : α → E) (g : α → F) : Prop :=
  IsO l f g ∧ IsO l g f
#align asymptotics.is_Theta Asymptotics.IsTheta

-- mathport name: «expr =Θ[ ] »
notation:100 f " =Θ[" l "] " g:100 => IsTheta l f g

theorem IsO.antisymm (h₁ : f =O[l] g) (h₂ : g =O[l] f) : f =Θ[l] g :=
  ⟨h₁, h₂⟩
#align asymptotics.is_O.antisymm Asymptotics.IsO.antisymm

@[refl]
theorem isTheta_refl (f : α → E) (l : Filter α) : f =Θ[l] f :=
  ⟨isO_refl _ _, isO_refl _ _⟩
#align asymptotics.is_Theta_refl Asymptotics.isTheta_refl

theorem isTheta_rfl : f =Θ[l] f :=
  isTheta_refl _ _
#align asymptotics.is_Theta_rfl Asymptotics.isTheta_rfl

@[symm]
theorem IsTheta.symm (h : f =Θ[l] g) : g =Θ[l] f :=
  h.symm
#align asymptotics.is_Theta.symm Asymptotics.IsTheta.symm

theorem isTheta_comm : f =Θ[l] g ↔ g =Θ[l] f :=
  ⟨fun h => h.symm, fun h => h.symm⟩
#align asymptotics.is_Theta_comm Asymptotics.isTheta_comm

@[trans]
theorem IsTheta.trans {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =Θ[l] g) (h₂ : g =Θ[l] k) :
    f =Θ[l] k :=
  ⟨h₁.1.trans h₂.1, h₂.2.trans h₁.2⟩
#align asymptotics.is_Theta.trans Asymptotics.IsTheta.trans

@[trans]
theorem IsO.trans_isTheta {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =O[l] g) (h₂ : g =Θ[l] k) :
    f =O[l] k :=
  h₁.trans h₂.1
#align asymptotics.is_O.trans_is_Theta Asymptotics.IsO.trans_isTheta

@[trans]
theorem IsTheta.trans_isO {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =Θ[l] g) (h₂ : g =O[l] k) :
    f =O[l] k :=
  h₁.1.trans h₂
#align asymptotics.is_Theta.trans_is_O Asymptotics.IsTheta.trans_isO

@[trans]
theorem IsOCat.trans_isTheta {f : α → E} {g : α → F} {k : α → G'} (h₁ : f =o[l] g)
    (h₂ : g =Θ[l] k) : f =o[l] k :=
  h₁.trans_isO h₂.1
#align asymptotics.is_o.trans_is_Theta Asymptotics.IsOCat.trans_isTheta

@[trans]
theorem IsTheta.trans_isOCat {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =Θ[l] g)
    (h₂ : g =o[l] k) : f =o[l] k :=
  h₁.1.trans_isOCat h₂
#align asymptotics.is_Theta.trans_is_o Asymptotics.IsTheta.trans_isOCat

@[trans]
theorem IsTheta.trans_eventuallyEq {f : α → E} {g₁ g₂ : α → F} (h : f =Θ[l] g₁) (hg : g₁ =ᶠ[l] g₂) :
    f =Θ[l] g₂ :=
  ⟨h.1.trans_eventuallyEq hg, hg.symm.trans_isO h.2⟩
#align asymptotics.is_Theta.trans_eventually_eq Asymptotics.IsTheta.trans_eventuallyEq

@[trans]
theorem Filter.EventuallyEq.trans_isTheta {f₁ f₂ : α → E} {g : α → F} (hf : f₁ =ᶠ[l] f₂)
    (h : f₂ =Θ[l] g) : f₁ =Θ[l] g :=
  ⟨hf.trans_isO h.1, h.2.trans_eventuallyEq hf.symm⟩
#align filter.eventually_eq.trans_is_Theta Filter.EventuallyEq.trans_isTheta

@[simp]
theorem isTheta_norm_left : (fun x => ‖f' x‖) =Θ[l] g ↔ f' =Θ[l] g := by simp [is_Theta]
#align asymptotics.is_Theta_norm_left Asymptotics.isTheta_norm_left

@[simp]
theorem isTheta_norm_right : (f =Θ[l] fun x => ‖g' x‖) ↔ f =Θ[l] g' := by simp [is_Theta]
#align asymptotics.is_Theta_norm_right Asymptotics.isTheta_norm_right

alias is_Theta_norm_left ↔ is_Theta.of_norm_left is_Theta.norm_left
#align asymptotics.is_Theta.of_norm_left Asymptotics.IsTheta.of_norm_left
#align asymptotics.is_Theta.norm_left Asymptotics.IsTheta.norm_left

alias is_Theta_norm_right ↔ is_Theta.of_norm_right is_Theta.norm_right
#align asymptotics.is_Theta.of_norm_right Asymptotics.IsTheta.of_norm_right
#align asymptotics.is_Theta.norm_right Asymptotics.IsTheta.norm_right

theorem isTheta_of_norm_eventuallyEq (h : (fun x => ‖f x‖) =ᶠ[l] fun x => ‖g x‖) : f =Θ[l] g :=
  ⟨IsO.of_bound 1 <| by simpa only [one_mul] using h.le,
    IsO.of_bound 1 <| by simpa only [one_mul] using h.symm.le⟩
#align asymptotics.is_Theta_of_norm_eventually_eq Asymptotics.isTheta_of_norm_eventuallyEq

theorem isTheta_of_norm_eventually_eq' {g : α → ℝ} (h : (fun x => ‖f' x‖) =ᶠ[l] g) : f' =Θ[l] g :=
  isTheta_of_norm_eventuallyEq <| h.mono fun x hx => by simp only [← hx, norm_norm]
#align asymptotics.is_Theta_of_norm_eventually_eq' Asymptotics.isTheta_of_norm_eventually_eq'

theorem IsTheta.isOCat_congr_left (h : f' =Θ[l] g') : f' =o[l] k ↔ g' =o[l] k :=
  ⟨h.symm.trans_isOCat, h.trans_isOCat⟩
#align asymptotics.is_Theta.is_o_congr_left Asymptotics.IsTheta.isOCat_congr_left

theorem IsTheta.isOCat_congr_right (h : g' =Θ[l] k') : f =o[l] g' ↔ f =o[l] k' :=
  ⟨fun H => H.trans_isTheta h, fun H => H.trans_isTheta h.symm⟩
#align asymptotics.is_Theta.is_o_congr_right Asymptotics.IsTheta.isOCat_congr_right

theorem IsTheta.isO_congr_left (h : f' =Θ[l] g') : f' =O[l] k ↔ g' =O[l] k :=
  ⟨h.symm.trans_isO, h.trans_isO⟩
#align asymptotics.is_Theta.is_O_congr_left Asymptotics.IsTheta.isO_congr_left

theorem IsTheta.isO_congr_right (h : g' =Θ[l] k') : f =O[l] g' ↔ f =O[l] k' :=
  ⟨fun H => H.trans_isTheta h, fun H => H.trans_isTheta h.symm⟩
#align asymptotics.is_Theta.is_O_congr_right Asymptotics.IsTheta.isO_congr_right

theorem IsTheta.mono (h : f =Θ[l] g) (hl : l' ≤ l) : f =Θ[l'] g :=
  ⟨h.1.mono hl, h.2.mono hl⟩
#align asymptotics.is_Theta.mono Asymptotics.IsTheta.mono

theorem IsTheta.sup (h : f' =Θ[l] g') (h' : f' =Θ[l'] g') : f' =Θ[l ⊔ l'] g' :=
  ⟨h.1.sup h'.1, h.2.sup h'.2⟩
#align asymptotics.is_Theta.sup Asymptotics.IsTheta.sup

@[simp]
theorem isTheta_sup : f' =Θ[l ⊔ l'] g' ↔ f' =Θ[l] g' ∧ f' =Θ[l'] g' :=
  ⟨fun h => ⟨h.mono le_sup_left, h.mono le_sup_right⟩, fun h => h.1.sup h.2⟩
#align asymptotics.is_Theta_sup Asymptotics.isTheta_sup

theorem IsTheta.eq_zero_iff (h : f'' =Θ[l] g'') : ∀ᶠ x in l, f'' x = 0 ↔ g'' x = 0 :=
  h.1.eq_zero_imp.mp <| h.2.eq_zero_imp.mono fun x => Iff.intro
#align asymptotics.is_Theta.eq_zero_iff Asymptotics.IsTheta.eq_zero_iff

theorem IsTheta.tendsto_zero_iff (h : f'' =Θ[l] g'') : Tendsto f'' l (𝓝 0) ↔ Tendsto g'' l (𝓝 0) :=
  by simp only [← is_o_one_iff ℝ, h.is_o_congr_left]
#align asymptotics.is_Theta.tendsto_zero_iff Asymptotics.IsTheta.tendsto_zero_iff

theorem IsTheta.tendsto_norm_atTop_iff (h : f' =Θ[l] g') :
    Tendsto (norm ∘ f') l atTop ↔ Tendsto (norm ∘ g') l atTop := by
  simp only [← is_o_const_left_of_ne (one_ne_zero' ℝ), h.is_o_congr_right]
#align asymptotics.is_Theta.tendsto_norm_at_top_iff Asymptotics.IsTheta.tendsto_norm_atTop_iff

theorem IsTheta.isBoundedUnder_le_iff (h : f' =Θ[l] g') :
    IsBoundedUnder (· ≤ ·) l (norm ∘ f') ↔ IsBoundedUnder (· ≤ ·) l (norm ∘ g') := by
  simp only [← is_O_const_of_ne (one_ne_zero' ℝ), h.is_O_congr_left]
#align asymptotics.is_Theta.is_bounded_under_le_iff Asymptotics.IsTheta.isBoundedUnder_le_iff

theorem IsTheta.smul [NormedSpace 𝕜 E'] [NormedSpace 𝕜' F'] {f₁ : α → 𝕜} {f₂ : α → 𝕜'} {g₁ : α → E'}
    {g₂ : α → F'} (hf : f₁ =Θ[l] f₂) (hg : g₁ =Θ[l] g₂) :
    (fun x => f₁ x • g₁ x) =Θ[l] fun x => f₂ x • g₂ x :=
  ⟨hf.1.smul hg.1, hf.2.smul hg.2⟩
#align asymptotics.is_Theta.smul Asymptotics.IsTheta.smul

theorem IsTheta.mul {f₁ f₂ : α → 𝕜} {g₁ g₂ : α → 𝕜'} (h₁ : f₁ =Θ[l] g₁) (h₂ : f₂ =Θ[l] g₂) :
    (fun x => f₁ x * f₂ x) =Θ[l] fun x => g₁ x * g₂ x :=
  h₁.smul h₂
#align asymptotics.is_Theta.mul Asymptotics.IsTheta.mul

theorem IsTheta.inv {f : α → 𝕜} {g : α → 𝕜'} (h : f =Θ[l] g) :
    (fun x => (f x)⁻¹) =Θ[l] fun x => (g x)⁻¹ :=
  ⟨h.2.inv_rev h.1.eq_zero_imp, h.1.inv_rev h.2.eq_zero_imp⟩
#align asymptotics.is_Theta.inv Asymptotics.IsTheta.inv

@[simp]
theorem isTheta_inv {f : α → 𝕜} {g : α → 𝕜'} :
    ((fun x => (f x)⁻¹) =Θ[l] fun x => (g x)⁻¹) ↔ f =Θ[l] g :=
  ⟨fun h => by simpa only [inv_inv] using h.inv, IsTheta.inv⟩
#align asymptotics.is_Theta_inv Asymptotics.isTheta_inv

theorem IsTheta.div {f₁ f₂ : α → 𝕜} {g₁ g₂ : α → 𝕜'} (h₁ : f₁ =Θ[l] g₁) (h₂ : f₂ =Θ[l] g₂) :
    (fun x => f₁ x / f₂ x) =Θ[l] fun x => g₁ x / g₂ x := by
  simpa only [div_eq_mul_inv] using h₁.mul h₂.inv
#align asymptotics.is_Theta.div Asymptotics.IsTheta.div

theorem IsTheta.pow {f : α → 𝕜} {g : α → 𝕜'} (h : f =Θ[l] g) (n : ℕ) :
    (fun x => f x ^ n) =Θ[l] fun x => g x ^ n :=
  ⟨h.1.pow n, h.2.pow n⟩
#align asymptotics.is_Theta.pow Asymptotics.IsTheta.pow

theorem IsTheta.zpow {f : α → 𝕜} {g : α → 𝕜'} (h : f =Θ[l] g) (n : ℤ) :
    (fun x => f x ^ n) =Θ[l] fun x => g x ^ n :=
  by
  cases n
  · simpa only [zpow_ofNat] using h.pow _
  · simpa only [zpow_negSucc] using (h.pow _).inv
#align asymptotics.is_Theta.zpow Asymptotics.IsTheta.zpow

theorem isTheta_const_const {c₁ : E''} {c₂ : F''} (h₁ : c₁ ≠ 0) (h₂ : c₂ ≠ 0) :
    (fun x : α => c₁) =Θ[l] fun x => c₂ :=
  ⟨isO_const_const _ h₂ _, isO_const_const _ h₁ _⟩
#align asymptotics.is_Theta_const_const Asymptotics.isTheta_const_const

@[simp]
theorem isTheta_const_const_iff [NeBot l] {c₁ : E''} {c₂ : F''} :
    ((fun x : α => c₁) =Θ[l] fun x => c₂) ↔ (c₁ = 0 ↔ c₂ = 0) := by
  simpa only [is_Theta, is_O_const_const_iff, ← iff_def] using Iff.comm
#align asymptotics.is_Theta_const_const_iff Asymptotics.isTheta_const_const_iff

@[simp]
theorem isTheta_zero_left : (fun x => (0 : E')) =Θ[l] g'' ↔ g'' =ᶠ[l] 0 := by
  simp only [is_Theta, is_O_zero, is_O_zero_right_iff, true_and_iff]
#align asymptotics.is_Theta_zero_left Asymptotics.isTheta_zero_left

@[simp]
theorem isTheta_zero_right : (f'' =Θ[l] fun x => (0 : F')) ↔ f'' =ᶠ[l] 0 :=
  isTheta_comm.trans isTheta_zero_left
#align asymptotics.is_Theta_zero_right Asymptotics.isTheta_zero_right

theorem isTheta_const_smul_left [NormedSpace 𝕜 E'] {c : 𝕜} (hc : c ≠ 0) :
    (fun x => c • f' x) =Θ[l] g ↔ f' =Θ[l] g :=
  and_congr (isO_const_smul_left hc) (isO_const_smul_right hc)
#align asymptotics.is_Theta_const_smul_left Asymptotics.isTheta_const_smul_left

alias is_Theta_const_smul_left ↔ is_Theta.of_const_smul_left is_Theta.const_smul_left
#align asymptotics.is_Theta.of_const_smul_left Asymptotics.IsTheta.of_const_smul_left
#align asymptotics.is_Theta.const_smul_left Asymptotics.IsTheta.const_smul_left

theorem isTheta_const_smul_right [NormedSpace 𝕜 F'] {c : 𝕜} (hc : c ≠ 0) :
    (f =Θ[l] fun x => c • g' x) ↔ f =Θ[l] g' :=
  and_congr (isO_const_smul_right hc) (isO_const_smul_left hc)
#align asymptotics.is_Theta_const_smul_right Asymptotics.isTheta_const_smul_right

alias is_Theta_const_smul_right ↔ is_Theta.of_const_smul_right is_Theta.const_smul_right
#align asymptotics.is_Theta.of_const_smul_right Asymptotics.IsTheta.of_const_smul_right
#align asymptotics.is_Theta.const_smul_right Asymptotics.IsTheta.const_smul_right

theorem isTheta_const_mul_left {c : 𝕜} {f : α → 𝕜} (hc : c ≠ 0) :
    (fun x => c * f x) =Θ[l] g ↔ f =Θ[l] g := by
  simpa only [← smul_eq_mul] using is_Theta_const_smul_left hc
#align asymptotics.is_Theta_const_mul_left Asymptotics.isTheta_const_mul_left

alias is_Theta_const_mul_left ↔ is_Theta.of_const_mul_left is_Theta.const_mul_left
#align asymptotics.is_Theta.of_const_mul_left Asymptotics.IsTheta.of_const_mul_left
#align asymptotics.is_Theta.const_mul_left Asymptotics.IsTheta.const_mul_left

theorem isTheta_const_mul_right {c : 𝕜} {g : α → 𝕜} (hc : c ≠ 0) :
    (f =Θ[l] fun x => c * g x) ↔ f =Θ[l] g := by
  simpa only [← smul_eq_mul] using is_Theta_const_smul_right hc
#align asymptotics.is_Theta_const_mul_right Asymptotics.isTheta_const_mul_right

alias is_Theta_const_mul_right ↔ is_Theta.of_const_mul_right is_Theta.const_mul_right
#align asymptotics.is_Theta.of_const_mul_right Asymptotics.IsTheta.of_const_mul_right
#align asymptotics.is_Theta.const_mul_right Asymptotics.IsTheta.const_mul_right

end Asymptotics


/-
Copyright (c) 2003-2007, John Harrison
Copyright (c) 2021, Shing Tak Lam
(See "LICENSE" for details)
-/

import HoPLaAR.Lib
import HoPLaAR.Aux.Result

inductive Expression
| Var (s : String)
| Const (n : Int)
| Add (e₁ e₂ : Expression)
| Mul (e₁ e₂ : Expression)
deriving Repr, Inhabited

namespace Expression

-- (* ------------------------------------------------------------------------- *)
-- (* Trivial example of using the type constructors.                           *)
-- (* ------------------------------------------------------------------------- *)

#check Add (Mul (Const 2) (Var "x")) (Var "y")

-- (* ------------------------------------------------------------------------- *)
-- (* Simplification example.                                                   *)
-- (* ------------------------------------------------------------------------- *)

def simplify₁ : Expression → Expression
| Add (Const n) (Const m) => Const (n + m)
| Mul (Const n) (Const m) => Const (n * m)
| Add (Const 0) x => x
| Add x (Const 0) => x
| Mul (Const 0) x => Const 0
| Mul x (Const 0) => Const 0
| Mul (Const 1) x => x
| Mul x (Const 1) => x
| x => x

partial def simplify : Expression → Expression
| Add e₁ e₂ => simplify₁ (Add (simplify e₁) (simplify e₂))
| Mul e₁ e₂ => simplify₁ (Mul (simplify e₁) (simplify e₂))
| x => simplify₁ x

-- (* ------------------------------------------------------------------------- *)
-- (* Example.                                                                  *)
-- (* ------------------------------------------------------------------------- *)

#eval let e := Add (Mul (Add (Mul (Const 0) (Var "x")) (Const 1)) (Const 3)) (Const 12)
      simplify e

end Expression

-- (* ------------------------------------------------------------------------- *)
-- (* Lexical analysis.                                                         *)
-- (* ------------------------------------------------------------------------- *)

-- let matches s = let chars = explode s in fun c -> mem c chars;;
def matches s c :=
  let chars := explode s
  chars.elem c

def space := matches " \n\t\r"
def punctuation := matches "(){}[],"
def symbolic := matches "~‘!@#$%^&*-+=|\\:;<>.?/"
def numeric := matches "0123456789"
def alphanumeric := matches
"abcdefghijklmnopqrstuvwxyz_'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

def lexwhile (prop : String → Bool) : (inp : List String) → String × List String
| c :: cs =>
  if prop c then
    let ⟨tok, rest⟩ := lexwhile prop cs
    (c ++ tok, rest)
  else
    ("", c::cs)
| [] => ("", [])

partial def lex (inp : List String) : List String :=
  match (lexwhile space inp).snd with
  | [] => []
  | c :: cs =>
    let prop :=
      if alphanumeric c then
        alphanumeric
      else if symbolic c then
        symbolic
      else
        λ x => false
    let ⟨tokl, rest⟩ := lexwhile prop cs
    (c ++ tokl) :: lex rest

#eval explode "2*((var_1 + x') + 11)" |> lex
#eval explode "if (*p1-- == *p2++) then f() else g()" |> lex

-- (* ------------------------------------------------------------------------- *)
-- (* Parsing.                                                                  *)
-- (* ------------------------------------------------------------------------- *)

namespace Expression

mutual
partial def parseExpression (i : List String) : Optional (Expression × List String) :=
  match parseProduct i with
  | Result.Ok (e₁, "+"::i₁) =>
    parseExpression i₁ |>.map (λ p => (Expression.Add e₁ p.1, p.2))
  | x => x
partial def parseProduct (i : List String) : Optional (Expression × List String) :=
  match parseAtom i with
  | Result.Ok (e₁, "*"::i₁) =>
    parseProduct i₁ |>.map (λ p => (Expression.Mul e₁ p.1, p.2))
  | x => x
partial def parseAtom (i : List String) : Optional (Expression × List String) :=
  match i with
  | [] => Result.Err "Expected Expression at End of Input"
  | "("::i₁ => match parseExpression i₁ with
               | Result.Ok (e₂, ")"::i₂) => Result.Ok (e₂, i₂)
               | _ => Result.Err "Expected Closing Bracket"
  | tok::i₁ => if tok |> explode |>.all numeric then
    Result.Ok (Expression.Const tok.toInt!, i₁)
  else
    Result.Ok (Expression.Var tok, i₁)
end

end Expression

-- (* ------------------------------------------------------------------------- *)
-- (* Generic function to impose lexing and exhaustion checking on a parser.    *)
-- (* ------------------------------------------------------------------------- *)

def makeParser (pfn : List String → Optional (α × List β)) (s : String) : Optional α :=
  s |> explode |> lex |> pfn |>.andThen
  (λ ⟨expr, rest⟩ => if rest.isEmpty then Result.Ok expr else Result.Err "Unparsed Input")

  -- (λ Expr
  -- if rest.isEmpty then Result.Ok expr else Result.Err "Unparsed Input"
  -- )

-- (* ------------------------------------------------------------------------- *)
-- (* Our parser.                                                               *)
-- (* ------------------------------------------------------------------------- *)

def defaultParser := makeParser Expression.parseExpression

#eval defaultParser "x + 1"

-- (* ------------------------------------------------------------------------- *)
-- (* Demonstrate automatic installation.                                       *)
-- (* ------------------------------------------------------------------------- *)

-- Omitted

-- (* ------------------------------------------------------------------------- *)
-- (* Conservatively bracketing first attempt at printer.                       *)
-- (* ------------------------------------------------------------------------- *)

namespace Expression

def StringOfExp' : Expression → String
| Var s => s
| Const n => toString n
| Add e₁ e₂ => "(" ++ StringOfExp' e₁ ++ " + " ++ StringOfExp' e₂ ++ ")"
| Mul e₁ e₂ => "(" ++ StringOfExp' e₁ ++ " * " ++ StringOfExp' e₂ ++ ")"

-- (* ------------------------------------------------------------------------- *)
-- (* Examples.                                                                 *)
-- (* ------------------------------------------------------------------------- *)

-- #eval defaultParser "x + 3 * y" |> StringOfExp'

-- (* ------------------------------------------------------------------------- *)
-- (* Somewhat better attempt.                                                  *)
-- (* ------------------------------------------------------------------------- *)

def StringOfExp (pr : Nat) : Expression → String
| Var s => s
| Const n => toString n
| Add e₁ e₂ =>
  let s := StringOfExp 3 e₁ ++ " + " ++ StringOfExp 2 e₂
  if 2 < pr then
    "(" ++ s ++ ")"
  else
    s
| Mul e₁ e₂ =>
  let s := StringOfExp 5 e₁ ++ " * " ++ StringOfExp 4 e₂
  if 4 < pr then
    "(" ++ s ++ ")"
  else
    s

-- (* ------------------------------------------------------------------------- *)
-- (* Install it.                                                               *)
-- (* ------------------------------------------------------------------------- *)

-- Omitted

-- (* ------------------------------------------------------------------------- *)
-- (* Examples.                                                                 *)
-- (* ------------------------------------------------------------------------- *)

#eval defaultParser "x + 3 * y" |>.map <| StringOfExp 0
#eval defaultParser "x + (3 * y)" |>.map <| StringOfExp 0
#eval defaultParser "1 + 2 + 3" |>.map <| StringOfExp 0
#eval defaultParser "((1 + 2) + 3) + 4" |>.map <| StringOfExp 0

-- (* ------------------------------------------------------------------------- *)
-- (* Example shows the problem.                                                *)
-- (* ------------------------------------------------------------------------- *)

#eval defaultParser "(x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10) * (y1 + y2 + y3 + y4 + y5 + y6 + y7 + y8 + y9 + y10)" |>.map <| StringOfExp 0

end Expression