import utils
import evaluation
import all
import basic.table
import system.io

section parse_nm

meta def parse_nm : string → tactic name := λ nm_str, do {
  flip lean.parser.run_with_input nm_str $ iterate_until lean.parser.ident (λ nm, pure ∘ bnot $ nm = name.anonymous) 100
}

end parse_nm

meta def unpack_tactic_strings : json → tactic (list string) := λ msg, match msg with
| (json.array $ msgs) := do {
    msgs.mmap $ λ msg, match msg with
    | (json.of_string x) := pure x
    | exc := tactic.fail format! "UNEXPECTED {exc}"
    end
  }
| exc := tactic.fail format! "UNEXPECTED {exc}"
end

meta def get_decl_name_and_tactics (msg : json) : tactic $ name × list string := do {
  decl_name_msg ← msg.lookup "task_id",
  decl_name_str ← match decl_name_msg with
    | (json.of_string x) := pure x
    | exc := tactic.fail format! "UNEXPECTED {exc}"
    end,
  decl_name ← parse_nm decl_name_str,
  tacs_msg ← msg.lookup "tactics",
  tac_strings ← unpack_tactic_strings tacs_msg,
  pure ⟨decl_name, tac_strings⟩
}

-- #eval do {
--   msg ← option.to_monad $ json.parse " { \"task_id\":\"and.comm\", \"tactics\":[\"intros\", \"refine ⟨_,_⟩; intro h; cases h; exact and.intro ‹_› ‹_›\"]}",
--   x@⟨nm, tacs⟩ ← io.run_tactic' (get_decl_name_and_tactics msg),
--   io.put_str_ln' format! "{x}"

-- }

example : ∀ {a b : Prop}, a ∧ b ↔ b ∧ a :=
begin
  intros, refine ⟨_,_⟩; intro h; cases h; exact and.intro ‹_› ‹_›
end

meta def example_msg : tactic json := json.parse
  " { \"task_id\":\"finset.filter_not\",
      \"tactics\":[
        \"intros a\",
        \"intros\",
        \"ext b\",
        \"by_cases p b; simp *\"
      ]
    }"

meta def buggy_example_msg : tactic json := json.parse $
  " { \"task_id\":\"mvqpf.cofix.bisim\",
      \"tactics\":[
        \"intros x y h\",
        \"rintros x₀ y₀ q₀ hr\",
        \"intros x y h\",
        \"induction x using fin2.elim0\"
      ]
    }"

meta def replay_proof (namespaces : list name := []) :
  (name × list string) → tactic expr := λ ⟨decl_name, tacs⟩, do {
  env₀ ← tactic.get_env,
  tsd ← get_tsd_at_decl decl_name,
  env ← get_env_at_decl decl_name,
  tactic.set_env_core env,
  rebuild_tactic_state tsd,
  [g] ← tactic.get_goals,
  goal ← tactic.infer_type g,
  tactic.trace format! "[replay_proof] TACTICS: {tacs}",
  for_ tacs $ λ tac_str, do {
    tac ← parse_itactic tac_str,
    tac
  },

  pf ← tactic.get_assignment g >>= tactic.instantiate_mvars,
  tactic.set_env_core env₀,
  tactic.done <|> tactic.fail format! "[replay_proof] ERROR: NOT DONE WITH {decl_name}",
  validate_proof pf,
  pure pf
}

-- this should pass all checks
-- run_cmd do {
--   msg ← example_msg,
--   get_decl_name_and_tactics msg >>= replay_proof
-- }

-- this should pass `done` check but fail validation
-- run_cmd do {
--   msg ← buggy_example_msg,
--   get_decl_name_and_tactics msg >>= replay_proof
-- }

meta def pf_term_size (pf : expr) : tactic ℕ := do {
  str ← (format.to_string ∘ format.flatten) <$> tactic.pp pf,
  pure str.length
}

meta def build_namespace_index (decls_file : string) : io $ dict name (list name) := do {
    nm_strs ← (io.mk_file_handle decls_file io.mode.read >>= λ f,
    (string.split (λ c, c = '\n') <$> buffer.to_string <$> io.fs.read_to_end f)),

  -- io.put_str_ln' format!"NM STRS: {nm_strs}",

  (nms : list (name × list name)) ← (nm_strs.filter $ λ nm_str, string.length nm_str > 0).mmap $ λ nm_str, do {
    ((io.run_tactic' ∘ parse_decl_nm_and_open_ns) $ nm_str)
  },

  io.put_str_ln' format!"[evaluation_harness_from_decls_file] GOT {nms.length} NAMES",

  -- io.put_str_ln' format!"NMS: {nms}",

  -- additionally filter out non-theorems
  -- TODO(): do this offline in a separate Lean script
  let nms_unfiltered_len := nms.length,
  nms ← io.run_tactic' $ do {
    env ← tactic.get_env,
    nms.mfilter $ λ ⟨nm, _⟩, (do {
      decl ← env.get nm,
      pure decl.is_theorem
    } <|> pure ff)
  },
  pure $ dict.of_list nms
}

meta def mk_shorter_proof_jsonline (old_size : ℕ) (new_size : ℕ)
  (decl_nm : name) (tacs : list string) : json := do {
  json.array $ [old_size, new_size, decl_nm.to_string, json.array $ json.of_string <$> tacs]
}

meta def main : io unit := do {
  args ← io.cmdline_args,
  jsons_file ← args.nth_except 0 "jsons_file",
  dest ← args.nth_except 1 "dest",
  ns_index_path ← args.nth_except 2 "ns_index",
  msg_strs ← io.mk_file_handle jsons_file io.mode.read >>= λ f,
    (string.split (λ c, c = '\n') <$> buffer.to_string <$> io.fs.read_to_end f),
  let msg_strs := msg_strs.filter (λ x, x.length > 0),
  msgs ← msg_strs.mmap (λ msg_str, lift_option $ json.parse msg_str),
  dest_handle ← io.mk_file_handle dest io.mode.write,
  ns_index ← build_namespace_index ns_index_path,
  for_ msgs $ λ msg, io.run_tactic' $ do {
    x@⟨decl_nm, tacs⟩ ← get_decl_name_and_tactics msg,
    if tacs.length = 0 then tactic.trace format! "SKIPPING {decl_nm}" else do
    tactic.trace format! "REPLAYING {decl_nm}",
    old_pf_term ← tactic.get_proof_from_env decl_nm,
    tactic.trace format! "PROCESSING DECL_NM {decl_nm}",
    env₀ ← tactic.get_env,
    tactic.try $ do {
      open_ns ← ns_index.get decl_nm,
      new_pf_term ← replay_proof open_ns x,
      tactic.set_env_core env₀,
      old_size ← pf_term_size old_pf_term,
      tactic.trace format! "OLD SIZE: {old_size}",
      new_size ← pf_term_size new_pf_term,
      tactic.trace format! "NEW SIZE: {new_size}",
      when (new_size < old_size) $ tactic.unsafe_run_io $ do {
        io.put_str_ln "FOUND SMALLER PROOF",
        io.fs.put_str_ln_flush dest_handle $
          json.unparse $ mk_shorter_proof_jsonline old_size new_size decl_nm tacs
      }},
    tactic.set_env_core env₀
  }
}


inductive Con : Type
| nil : Con
| foo : Con

inductive Conw : Con → Prop
| nilw : Conw Con.nil

example (x : Conw Con.nil) : x = Conw.nilw := by
  cases x
  trace_state
  rfl


import for_mathlib.Profinite.extend
import for_mathlib.Profinite.product

import data.fintype.card
import category_theory.limits.functor_category
import category_theory.limits.shapes.binary_products
import category_theory.functor.currying

import facts
import hacks_and_tricks.type_pow

import Lbar.basic
import pseudo_normed_group.profinitely_filtered

/-!
# $\overline{\mathcal{M}}_{r'}(S)_{≤ c}$

In this file we put a profinite topology on the subspace
`Lbar_le r' S c` of `Lbar r' S` consisting of power series
`F_s = ∑ a_{n,s}T^n ∈ Tℤ⟦T⟧` such that `∑_{n,s} |a_{n,s}|r'^n ≤ c`.
-/

universe u

noncomputable theory
open_locale big_operators nnreal
open pseudo_normed_group category_theory category_theory.limits
local attribute [instance] type_pow

variables {r' : ℝ≥0} {S : Type u} [fintype S] {c c₁ c₂ c₃ : ℝ≥0}

/-- `Lbar_le r' S c` is the set of power series
`F_s = ∑ a_{n,s}T^n ∈ Tℤ[[T]]` such that `∑_{n,s} |a_{n,s}|r'^n ≤ c` -/
def Lbar_le (r' : ℝ≥0) (S : Type u) [fintype S] (c : ℝ≥0) :=
{ F : Lbar r' S // F ∈ filtration (Lbar r' S) c }

namespace Lbar_le

instance has_coe : has_coe (Lbar_le r' S c) (Lbar r' S) := ⟨subtype.val⟩

instance has_coe_to_fun : has_coe_to_fun (Lbar_le r' S c) (λ F, S → ℕ → ℤ) := ⟨λ F, F.1⟩

@[simp] lemma coe_coe_to_fun (F : Lbar_le r' S c) : ⇑(F : Lbar r' S) = F := rfl

@[simp] lemma coe_mk (x h) : ((⟨x, h⟩ : Lbar_le r' S c) : S → ℕ → ℤ) = x := rfl

@[simp] protected lemma coeff_zero (x : Lbar_le r' S c) (s : S) : x s 0 = 0 := x.1.coeff_zero' s

protected lemma summable (x : Lbar_le r' S c) (s : S) :
  summable (λ n, (↑(x s n).nat_abs * r'^n)) := x.1.summable' s

protected lemma mem_filtration (x : Lbar_le r' S c) :
  x.1 ∈ filtration (Lbar r' S) c := x.property

/-- The inclusion map `Lbar_le r' S c₁ → Lbar_le r' S c₂` for `c₁ ≤ c₂`. -/
protected def cast_le [hc : fact (c₁ ≤ c₂)] (x : Lbar_le r' S c₁) : Lbar_le r' S c₂ :=
⟨⟨x, x.coeff_zero, x.summable⟩, filtration_mono hc.out x.mem_filtration⟩

@[simp] lemma coe_cast_le [hc : fact (c₁ ≤ c₂)] (x : Lbar_le r' S c₁) :
  ((x.cast_le : Lbar_le r' S c₂) : Lbar r' S) = x :=
by { ext, refl }

@[simp] lemma cast_le_apply [hc : fact (c₁ ≤ c₂)] (x : Lbar_le r' S c₁) (s : S) (i : ℕ) :
  (x.cast_le : Lbar_le r' S c₂) s i = x s i :=
rfl

lemma injective_cast_le [fact (c₁ ≤ c₂)] :
  function.injective (Lbar_le.cast_le : Lbar_le r' S c₁ → Lbar_le r' S c₂) :=
λ x y h,
begin
  ext s n,
  change x.cast_le s n = y.cast_le s n,
  rw h,
end

@[ext] lemma ext (x y : Lbar_le r' S c) (h : (⇑x: S → ℕ → ℤ) = y) : x = y :=
by { ext:2, exact h }

instance : has_zero (Lbar_le r' S c) := ⟨⟨0, zero_mem_filtration _⟩⟩

instance : inhabited (Lbar_le r' S c) := ⟨0⟩

end Lbar_le

variables (c₃)

/-- The addition on `Lbar_le`.
This addition is not homogeneous, but has type
`(Lbar_le r' S c₁) → (Lbar_le r' S c₂) → (Lbar_le r' S c₃)`
for `c₁ + c₂ ≤ c₃`. -/
def Lbar_le.add [h : fact (c₁ + c₂ ≤ c₃)]
  (F : Lbar_le r' S c₁) (G : Lbar_le r' S c₂) :
  Lbar_le r' S c₃ :=
subtype.mk (F + G) $ filtration_mono h.out $ add_mem_filtration F.mem_filtration G.mem_filtration

/-- An uncurried version of addition on `Lbar_le`,
meaning that it takes only 1 input, coming from a product type. -/
def Lbar_le.add' [fact (c₁ + c₂ ≤ c₃)] :
  Lbar_le r' S c₁ × Lbar_le r' S c₂ → Lbar_le r' S c₃ :=
λ x, Lbar_le.add c₃ x.1 x.2

-- TODO: register this as an instance??
/-- The negation on `Lbar_le`. -/
def Lbar_le.neg (F : Lbar_le r' S c) : Lbar_le r' S c :=
subtype.mk (-F) $ neg_mem_filtration F.mem_filtration

namespace Lbar_le

/-- The truncation map from Lbar_le to `Lbar_bdd`. -/
@[simps] def truncate (M : ℕ) (F : Lbar_le r' S c) : Lbar_bdd r' ⟨S⟩ c M :=
{ to_fun := λ s n, F s n,
  coeff_zero' := by simp,
  sum_le' :=
  begin
    refine le_trans _ F.mem_filtration,
    apply finset.sum_le_sum,
    rintros (s : S) -,
    rw fin.sum_univ_eq_sum_range (λ i, (↑(F s i).nat_abs * r' ^i)) (M+1),
    exact sum_le_tsum _ (λ _ _, subtype.property (_ : ℝ≥0)) (F.summable s),
  end }

lemma truncate_surjective (M : ℕ) :
  function.surjective (truncate M : Lbar_le r' S c → Lbar_bdd r' ⟨S⟩ c M) :=
begin
  intro x,
  have aux : _ := _,
  let F : Lbar_le r' S c :=
  ⟨{ to_fun := λ s n, if h : n < M + 1 then x s ⟨n, h⟩ else 0,
     summable' := aux, .. }, _⟩,
  { use F, ext s i, simp only [truncate_to_fun], dsimp,
    rw dif_pos i.is_lt, simp only [fin.eta] },
  { intro s, rw dif_pos (nat.zero_lt_succ _), exact x.coeff_zero s },
  { apply le_trans _ x.sum_le,
    apply finset.sum_le_sum,
    rintro s -,
    rw [← sum_add_tsum_nat_add' (M + 1), tsum_eq_zero, add_zero],
    { rw ← fin.sum_univ_eq_sum_range,
      apply finset.sum_le_sum,
      rintro i -,
      simp only [dif_pos i.is_lt, fin.eta, Lbar.coe_mk] },
    { intro i,
      dsimp,
      rw [dif_neg, int.nat_abs_zero, nat.cast_zero, zero_mul],
      linarith },
    { dsimp, apply aux } },
  { intro s,
    apply @summable_of_ne_finset_zero _ _ _ _ _ (finset.range (M+1)),
    intros i hi,
    rw finset.mem_range at hi,
    simp only [hi, zero_mul, dif_neg, not_false_iff, nat.cast_zero, int.nat_abs_zero] }
end

/-- Injectivity of the map `Lbar_le` to the limit of the `Lbar_bdd`. -/
lemma eq_iff_truncate_eq (x y : Lbar_le r' S c)
  (cond : ∀ M, truncate M x = truncate M y) : x = y :=
begin
  ext s n,
  change (truncate n x).1 s ⟨n, by linarith⟩ = (truncate n y).1 s ⟨n,_⟩,
  rw cond,
end

lemma truncate_cast_le (M : ℕ) [hc : fact (c₁ ≤ c₂)] (x : Lbar_le r' S c₁) :
  truncate M (Lbar_le.cast_le x : Lbar_le r' S c₂) = Lbar_bdd.cast_le (truncate M x) :=
rfl

/-- Underlying function of the element of `Lbar_le r' S c` associated to a sequence of
  elements of the truncated Lbars. -/
def mk_seq (T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M) : S → ℕ → ℤ :=
λ s n, (T n).1 s ⟨n, lt_add_one n⟩

@[simp] lemma mk_seq_zero {T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M} (s : S) : mk_seq T s 0 = 0 :=
(T 0).coeff_zero s

lemma mk_seq_eq_of_compat {T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M}
  (compat : ∀ (M N : ℕ) (h : M ≤ N), Lbar_bdd.transition r' h (T N) = T M)
  {s : S} {n : ℕ} {M : ℕ} (hnM : n < M + 1) :
  mk_seq T s n = (T M).1 s ⟨n, hnM⟩ :=
begin
  have hnM : n ≤ M := nat.lt_succ_iff.mp hnM,
  unfold mk_seq,
  rw ← compat n M hnM,
  apply Lbar_bdd.transition_eq,
end

lemma mk_seq_sum_range_eq (T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M)
  (compat : ∀ (M N : ℕ) (h : M ≤ N), Lbar_bdd.transition r' h (T N) = T M) (s : S) (n) :
  ∑ i in finset.range (n+1), (↑(mk_seq T s i).nat_abs * r'^i) =
  ∑ i : fin (n+1), (↑((T n).1 s i).nat_abs * r'^(i:ℕ)) :=
begin
  rw ← fin.sum_univ_eq_sum_range,
  congr',
  ext ⟨i, hi⟩,
  congr',
  exact mk_seq_eq_of_compat compat _,
end

lemma mk_seq_summable {T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M}
  (compat : ∀ (M N : ℕ) (h : M ≤ N), Lbar_bdd.transition r' h (T N) = T M) (s : S) :
  summable (λ (n : ℕ), (↑(mk_seq T s n).nat_abs * r' ^ n)) :=
begin
  apply @nnreal.summable_of_sum_range_le _ c,
  rintro (_|n),
  { simp only [finset.sum_empty, finset.range_zero, zero_le'] },
  { rw mk_seq_sum_range_eq T compat s n,
    refine le_trans _ (T n).sum_le,
    refine finset.single_le_sum (λ _ _, _) (finset.mem_univ s),
    apply zero_le' },
end

open filter

lemma mk_seq_tendsto {T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M}
  (compat : ∀ (M N : ℕ) (h : M ≤ N), Lbar_bdd.transition r' h (T N) = T M) :
  tendsto (λ (n : ℕ), ∑ (s : S), ∑  i in finset.range n, (↑(mk_seq T s i).nat_abs * r'^i))
  at_top (nhds $ ∑ (s : S), ∑' n, (↑(mk_seq T s n).nat_abs * r'^n)) :=
tendsto_finset_sum _ $ λ s _, has_sum.tendsto_sum_nat $ summable.has_sum $ mk_seq_summable compat s

lemma mk_seq_sum_le {T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M}
  (compat : ∀ (M N : ℕ) (h : M ≤ N), Lbar_bdd.transition r' h (T N) = T M) :
  (∑ s, ∑' (n : ℕ), (↑(mk_seq T s n).nat_abs * r' ^ n)) ≤ c :=
begin
  refine le_of_tendsto (mk_seq_tendsto compat) (eventually_of_forall _),
  rintro (_|n),
  { simp only [finset.sum_empty, finset.range_zero, finset.sum_const_zero, zero_le'] },
  { convert (T n).sum_le,
    funext,
    rw mk_seq_sum_range_eq T compat s n,
    refl }
end

lemma truncate_mk_seq {T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M}
  (compat : ∀ (M N : ℕ) (h : M ≤ N), Lbar_bdd.transition r' h (T N) = T M) (M : ℕ) :
  truncate M ⟨⟨mk_seq T, mk_seq_zero, mk_seq_summable compat⟩, mk_seq_sum_le compat⟩ = T M :=
begin
  ext s ⟨i, hi⟩,
  exact mk_seq_eq_of_compat compat _,
end

/-- `of_compat hT` is the limit of a compatible family `T M : Lbar_bdd r' ⟨S⟩ c M`.
This realizes `Lbar_le` as the profinite limit of the spaces `Lbar_bdd`,
see also `Lbar_le.eqv`. -/
def of_compat {T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M}
  (compat : ∀ (M N : ℕ) (h : M ≤ N), Lbar_bdd.transition r' h (T N) = T M) : Lbar_le r' S c :=
⟨⟨mk_seq T, mk_seq_zero, mk_seq_summable compat⟩, mk_seq_sum_le compat⟩

@[simp] lemma truncate_of_compat {T : Π (M : ℕ), Lbar_bdd r' ⟨S⟩ c M}
  (compat : ∀ (M N : ℕ) (h : M ≤ N), Lbar_bdd.transition r' h (T N) = T M) (M : ℕ) :
  truncate M (of_compat compat) = T M :=
begin
  ext s ⟨i, hi⟩,
  exact mk_seq_eq_of_compat compat _,
end

/-- The equivalence (as types) between `Lbar_le r' S c`
and the profinite limit of the spaces `Lbar_bdd r' ⟨S⟩ c M`. -/
def eqv : Lbar_le r' S c ≃ Lbar_bdd.limit r' ⟨S⟩ c :=
{ to_fun := λ F, ⟨λ N, truncate _ F, by { intros, refl }⟩,
  inv_fun := λ F, of_compat F.2,
  left_inv := λ x, by { ext, refl },
  right_inv := by { rintro ⟨x, hx⟩, simp only [truncate_of_compat], } }

section topological_structure

instance : topological_space (Lbar_le r' S c) := topological_space.induced eqv (by apply_instance)

lemma is_open_iff {U : set (Lbar_bdd.limit r' ⟨S⟩ c)} : is_open (eqv ⁻¹' U) ↔ is_open U :=
begin
  rw is_open_induced_iff,
  have := function.surjective.preimage_injective (equiv.surjective (eqv : Lbar_le r' S c ≃ _)),
  simp only [iff_self, this.eq_iff],
  simp only [exists_eq_right],
end

/-- The homeomorphism between `Lbar_le r' S c`
and the profinite limit of the spaces `Lbar_bdd r' ⟨S⟩ c M`.

This is `Lbar_le.eqv`, lifted to a homeomorphism by transporting
the topology from the profinite limit to `Lbar_le`. -/
def homeo : Lbar_le r' S c ≃ₜ Lbar_bdd.limit r' ⟨S⟩ c :=
{ continuous_to_fun := begin
    simp only [equiv.to_fun_as_coe, continuous_def],
    intros U hU,
    rwa is_open_iff
  end,
  continuous_inv_fun := begin
    simp only [equiv.to_fun_as_coe, continuous_def],
    intros U hU,
    erw [← eqv.image_eq_preimage, ← is_open_iff],
    rwa eqv.preimage_image U,
  end,
  ..eqv }

lemma truncate_eq (M : ℕ) :
  (truncate M : Lbar_le r' S c → Lbar_bdd r' ⟨S⟩ c M) = (Lbar_bdd.proj M) ∘ homeo := rfl

instance : t2_space (Lbar_le r' S c) :=
⟨λ x y h, separated_by_continuous homeo.continuous (λ c, h $ homeo.injective c)⟩

instance [fact (0 < r')] : compact_space (Lbar_le r' S c) :=
begin
  constructor,
  rw homeo.embedding.is_compact_iff_is_compact_image,
  simp only [set.image_univ, homeomorph.range_coe],
  obtain ⟨h⟩ := (by apply_instance : compact_space (Lbar_bdd.limit r' ⟨S⟩ c)),
  exact h,
end

instance : totally_disconnected_space (Lbar_le r' S c) :=
{ is_totally_disconnected_univ :=
  begin
    rintros A - hA,
    suffices subsing : (homeo '' A).subsingleton,
    { intros x hx y hy, apply_rules [homeo.injective, subsing, set.mem_image_of_mem] },
    obtain ⟨h⟩ := (by apply_instance : totally_disconnected_space (Lbar_bdd.limit r' ⟨S⟩ c)),
    exact h _ (by tauto) (is_preconnected.image hA _ homeo.continuous.continuous_on)
  end }

lemma continuous_iff {α : Type*} [topological_space α] (f : α → Lbar_le r' S c) :
  continuous f ↔ (∀ M, continuous ((truncate M) ∘ f)) :=
begin
  split,
  { intros hf M,
    rw [truncate_eq, function.comp.assoc],
    revert M,
    rw ← Lbar_bdd.continuous_iff,
    refine continuous.comp homeo.continuous hf },
  { intro h,
    suffices : continuous (homeo ∘ f), by rwa homeo.comp_continuous_iff at this,
    rw Lbar_bdd.continuous_iff,
    exact h }
end

lemma continuous_truncate {M} : continuous (@truncate r' S _ c M) :=
(continuous_iff id).mp continuous_id _

lemma continuous_add' :
  continuous (Lbar_le.add' (c₁ + c₂) : Lbar_le r' S c₁ × Lbar_le r' S c₂ → Lbar_le r' S (c₁+c₂)) :=
begin
  rw continuous_iff,
  intros M,
  have : truncate M ∘ (λ x : Lbar_le r' S c₁ × Lbar_le r' S c₂, Lbar_le.add _ x.1 x.2) =
    (λ x : (Lbar_le r' S c₁ × Lbar_le r' S c₂), Lbar_bdd.add (truncate M x.1) (truncate M x.2)) :=
    by {ext; refl},
  erw this,
  suffices : continuous (λ x : Lbar_bdd r' ⟨S⟩ c₁ M × Lbar_bdd r' ⟨S⟩ c₂ M, Lbar_bdd.add x.1 x.2),
  { have claim : (λ x : (Lbar_le r' S c₁ × Lbar_le r' S c₂),
      Lbar_bdd.add (truncate M x.1) (truncate M x.2)) =
      (λ x : Lbar_bdd r' ⟨S⟩ c₁ M × Lbar_bdd r' ⟨S⟩ c₂ M, Lbar_bdd.add x.1 x.2) ∘
      (λ x : Lbar_le r' S c₁ × Lbar_le r' S c₂, (truncate M x.1, truncate M x.2)), by {ext, refl},
    rw claim,
    refine continuous.comp this _,
    refine continuous.prod_map continuous_truncate continuous_truncate },
  exact continuous_of_discrete_topology,
end

lemma continuous_neg : continuous (Lbar_le.neg : Lbar_le r' S c → Lbar_le r' S c) :=
begin
  rw continuous_iff,
  intro M,
  change continuous (λ x : Lbar_le r' S c, Lbar_bdd.neg (truncate M x)),
  exact continuous.comp continuous_of_discrete_topology continuous_truncate,
end

end topological_structure

lemma continuous_cast_le (r' : ℝ≥0) (S : Type u) [fintype S] (c₁ c₂ : ℝ≥0) [hc : fact (c₁ ≤ c₂)] :
  continuous (@Lbar_le.cast_le r' S _ c₁ c₂ _) :=
begin
  rw continuous_iff,
  intro M,
  simp only [function.comp, truncate_cast_le],
  exact continuous_bot.comp continuous_truncate
end

/-! We now prove some scaffolding lemmas
in order to prove that the action of `T⁻¹` is continuous. -/

lemma continuous_of_normed_group_hom
  (f : (Lbar r' S) →+ (Lbar r' S))
  (g : Lbar_le r' S c₁ → Lbar_le r' S c₂)
  (h : ∀ x, ↑(g x) = f x)
  (H : ∀ M, ∃ N, ∀ (F : Lbar r' S),
    (∀ s i, i < N + 1 → F s i = 0) → (∀ s i, i < M + 1 → f F s i = 0)) :
  continuous g :=
begin
  rw continuous_iff,
  intros M,
  rcases H M with ⟨N, hN⟩,
  let φ : Lbar_bdd r' ⟨S⟩ c₁ N → Lbar_le r' S c₁ :=
    classical.some (truncate_surjective N).has_right_inverse,
  have hφ : function.right_inverse φ (truncate N) :=
    classical.some_spec (truncate_surjective N).has_right_inverse,
  suffices : truncate M ∘ g = truncate M ∘ g ∘ φ ∘ truncate N,
  { rw [this, ← function.comp.assoc, ← function.comp.assoc],
    apply continuous_bot.comp continuous_truncate },
  ext1 x,
  suffices : ∀ s i, i < M + 1 → (g x) s i = (g (φ (truncate N x))) s i,
  { ext s i, dsimp [function.comp], apply this, exact i.property },
  intros s i hi,
  rw [← coe_coe_to_fun, h, ← coe_coe_to_fun, h, ← sub_eq_zero],
  show ((f x) - f (φ (truncate N x))) s i = 0,
  rw [← f.map_sub],
  apply hN _ _ _ _ hi,
  clear hi i s, intros s i hi,
  simp only [Lbar.coe_sub, pi.sub_apply, sub_eq_zero],
  suffices : ∀ s i, (truncate N x) s i = truncate N (φ (truncate N x)) s i,
  { exact this s ⟨i, hi⟩ },
  intros s i, congr' 1,
  rw hφ (truncate N x)
end

/-- Construct a map between `Lbar_le r' S c₁` and `Lbar_le r' S c₂`
from a bounded group homomorphism `Lbar r' S → Lbar r' S`.

If `f` satisfies a suitable criterion,
then the constructed map is continuous for the profinite topology;
see `continuous_of_normed_group_hom`. -/
def hom_of_normed_group_hom {C : ℝ≥0} (c₁ c₂ : ℝ≥0) [hc : fact (C * c₁ ≤ c₂)]
  (f : Lbar r' S →+ Lbar r' S) (h : f ∈ filtration (Lbar r' S →+ Lbar r' S) C)
  (F : Lbar_le r' S c₁) :
  Lbar_le r' S c₂ :=
⟨{ to_fun := λ s i, f F s i,
  coeff_zero' := Lbar.coeff_zero _,
  summable' := Lbar.summable _ },
  filtration_mono hc.out (h F.mem_filtration)⟩

lemma continuous_hom_of_normed_group_hom {C : ℝ≥0} (c₁ c₂ : ℝ≥0)
  [hc : fact (C * c₁ ≤ c₂)]
  (f : Lbar r' S →+ Lbar r' S) (h : f ∈ filtration (Lbar r' S →+ Lbar r' S) C)
  (H : ∀ M, ∃ N, ∀ (F : Lbar r' S),
    (∀ s i, i < N + 1 → F s i = 0) → (∀ s i, i < M + 1 → f F s i = 0)) :
  continuous (hom_of_normed_group_hom c₁ c₂ f h) :=
continuous_of_normed_group_hom f _ (λ F, by { ext, refl }) H

@[simp] lemma coe_hom_of_normed_group_hom_apply {C : ℝ≥0} (c₁ c₂ : ℝ≥0)
  [hc : fact (C * c₁ ≤ c₂)]
  (f : Lbar r' S →+ Lbar r' S) (h : f ∈ filtration (Lbar r' S →+ Lbar r' S) C)
  (F : (Lbar_le r' S c₁)) (s : S) (i : ℕ) :
  (hom_of_normed_group_hom c₁ c₂ f h) F s i = f F s i := rfl

section Tinv

/-!
### The action of T⁻¹
-/

/-- The action of `T⁻¹` as map `Lbar_le r S c₁ → Lbar_le r S c₂`.

This action is induced by the action of `T⁻¹` on power series modulo constants: `ℤ⟦T⟧/ℤ`.
So `T⁻¹` sends `T^(n+1)` to `T^n`, but `T^0 = 0`. -/
def Tinv {r : ℝ≥0} {S : Type u} [fintype S] {c₁ c₂ : ℝ≥0} [fact (0 < r)] [fact (r⁻¹ * c₁ ≤ c₂)] :
  Lbar_le r S c₁ → Lbar_le r S c₂ :=
hom_of_normed_group_hom c₁ c₂ Lbar.Tinv Lbar.Tinv_mem_filtration

@[simp] lemma Tinv_apply {r : ℝ≥0} {S : Type u} [fintype S] {c₁ c₂ : ℝ≥0}
  [fact (0 < r)] [fact (r⁻¹ * c₁ ≤ c₂)] (F : Lbar_le r S c₁) (s : S) (i : ℕ) :
  (Tinv F : Lbar_le r S c₂) s i = Lbar.Tinv (F : Lbar r S) s i :=
rfl

lemma continuous_Tinv (r : ℝ≥0) (S : Type u) [fintype S] (c₁ c₂ : ℝ≥0)
  [fact (0 < r)] [fact (r⁻¹ * c₁ ≤ c₂)] :
  continuous (@Tinv r S _ c₁ c₂ _ _) :=
continuous_hom_of_normed_group_hom c₁ c₂ _ Lbar.Tinv_mem_filtration $
begin
  intros M,
  use M+1,
  rintro F hF s (_|i) hi,
  { simp only [Lbar.Tinv, add_monoid_hom.mk'_apply, Lbar.coe_mk, Lbar.Tinv_aux_zero] },
  { simp only [Lbar.Tinv, Lbar.Tinv_aux_succ, add_monoid_hom.mk'_apply, Lbar.coe_mk],
    apply hF,
    exact nat.succ_lt_succ hi },
end

end Tinv

/-

section map

/-- TODO -/
def map {S T : Fintype} (f : S ⟶ T) : Lbar_le r' S c → Lbar_le r' T c := λ F,
⟨(F : Lbar r' S).map f, Lbar.nnnorm_map_le_of_nnnorm_le _ _ F.2⟩

lemma map_truncate {S T : Fintype} (f : S ⟶ T) (F : Lbar_le r' S c) (M : ℕ) :
  ((F.truncate M).map f) = (F.map f).truncate M := rfl

lemma map_continuous {S T : Fintype} (f : S ⟶ T) : continuous
  (map f : Lbar_le r' S c → Lbar_le r' T c) :=
begin
  rw continuous_iff,
  intros M,
  have : truncate M ∘ (map f : Lbar_le r' S c → Lbar_le r' T c) =
    Lbar_bdd.map f ∘ truncate M, { ext, refl },
  rw this,
  refine continuous.comp _ continuous_truncate,
  continuity,
end

end map

variables (r' c)

/-- A version of `Lbar_le` which is functorial in `S`. -/
@[simps]
def Fintype_functor [fact (0 < r')] : Fintype.{u} ⥤ Profinite.{u} :=
{ obj := λ S, Profinite.of $ Lbar_le r' S c,
  map := λ S T f,
  { to_fun := map f,
    continuous_to_fun := map_continuous _ },
  map_id' := λ S, begin
    ext1,
    exact subtype.ext x.1.map_id,
  end,
  map_comp' := λ S T U f g, begin
    ext1,
    exact subtype.ext (x.1.map_comp f g),
  end }

variables (c₁ c₂)
/-- The functor sending `S` to the (categorical) product
  of `Lbar_le r' S c₁` and `Lbar_le r' S c₂`. -/
@[simps]
def Fintype_functor_prod [fact (0 < r')] : Fintype.{u} ⥤ Profinite.{u} :=
{ obj := λ S, (S,S),
  map := λ _ _ f, (f,f) } ⋙
    (Fintype_functor r' c₁).prod (Fintype_functor r' c₂) ⋙
    (uncurry.obj prod.functor)

/-- This is a functorial version of `add'`. -/
@[simps]
def Fintype_add_functor [fact (0 < r')] :
  Fintype_functor_prod.{u} r' c₁ c₂ ⟶ Fintype_functor.{u} r' (c₁ + c₂) :=
{ app := λ S, (Profinite.prod_iso _ _).hom ≫ ⟨add' _, continuous_add'⟩,
  naturality' := begin
    intros S T f,
    ext,
    dsimp only [functor.prod, Profinite.prod_iso, Fintype_functor_prod,
      uncurry, prod.functor, functor.comp_map],
    rw [category_theory.limits.prod.map_map, category.comp_id, category.id_comp],
    dsimp [map, Lbar.map, add', add, is_limit.cone_point_unique_up_to_iso,
      is_limit.unique_up_to_iso],
    rw finset.sum_add_distrib,
    -- annoying
    have useful : ∀ {A B C : Profinite} (f : A ⟶ B) (g : B ⟶ C) (a : A),
      (f ≫ g) a = g (f a) := λ _ _ _ _ _ _, rfl,
    congr,
    { have : binary_fan.fst (limit.cone (pair (Profinite.of (Lbar_le r' ↥T c₁))
        (Profinite.of (Lbar_le r' ↥T c₂)))) = category_theory.limits.prod.fst := rfl,
      rw [this, ← useful, category_theory.limits.prod.map_fst],
      refl },
    { have : binary_fan.snd (limit.cone (pair (Profinite.of (Lbar_le r' ↥T c₁))
        (Profinite.of (Lbar_le r' ↥T c₂)))) = category_theory.limits.prod.snd := rfl,
      rw [this, ← useful, category_theory.limits.prod.map_snd],
      refl },
  end}

/-- Negation on `Lbar_le` as a functor in `S`. -/
def Fintype_neg_functor [fact (0 < r')] : Fintype_functor.{u} r' c ⟶ Fintype_functor.{u} r' c :=
{ app := λ S, ⟨Lbar_le.neg, Lbar_le.continuous_neg⟩,
  naturality' := begin
    intros A B f,
    ext,
    dsimp [map, neg],
    simp,
  end }

variables {c₁ c₂}

open category_theory

/-- A bifunctor version of `Fintype_functor`, where `c` can vary. -/
@[simps]
def Fintype_bifunctor [fact (0 < r')] : ℝ≥0 ⥤ Fintype.{u} ⥤ Profinite.{u} :=
{ obj := λ c, Fintype_functor r' c,
  map := λ c₁ c₂ f,
  { app := λ S,
    { to_fun := @Lbar_le.cast_le r' S _ c₁ c₂ ⟨le_of_hom f⟩,
      continuous_to_fun := by apply continuous_cast_le } },
  map_id' := λ c, by { ext, refl },
  map_comp' := λ a b c f g, by { ext, refl } }

/-- The extension of `Fintype_functor` to `Profinite` obtained by taking limits. -/
@[simps]
def functor [fact (0 < r')] : Profinite.{u} ⥤ Profinite.{u} :=
Profinite.extend (Fintype_functor r' c)

variables (c₁ c₂)

/-- The profinite variant of `Fintype_functor_prod`. -/
@[simps]
def functor_prod [fact (0 < r')] : Profinite.{u} ⥤ Profinite.{u} :=
{ obj := λ S, (S,S), map := λ _ _ f, (f, f) } ⋙
  (functor r' c₁).prod (functor r' c₂) ⋙
  (uncurry.obj prod.functor)

/-- A cone over `(S.fintype_diagram ⋙ Fintype_functor_prod r' c₁ c₂)` used in the definition
  of `add_functor`. -/
def functor_prod_cone [fact (0 < r')] (S : Profinite) :
  cone (S.fintype_diagram ⋙ Fintype_functor_prod.{u} r' c₁ c₂) :=
{ X := (functor_prod r' c₁ c₂).obj S,
  π :=
  { app := λ I, category_theory.limits.prod.map (limit.π _ I) (limit.π _ I),
    naturality' := begin
      intros I J f,
      dsimp [Fintype_functor_prod],
      simp [← limit.w _ f],
    end } }

-- TODO: this proof is SLOW.
/-- The profinite variant of `Fintype_add_functor`. -/
def add_functor [fact (0 < r')] : functor_prod.{u} r' c₁ c₂ ⟶ functor.{u} r' (c₁ + c₂) :=
-- Why doesn't this work without the "by apply ..."?
{ app := λ S, by apply limit.lift _ (functor_prod_cone r' c₁ c₂ S) ≫
      category_theory.limits.lim.map (whisker_left _ (Fintype_add_functor _ _ _)),
  naturality' := begin
    intros S T f,
    erw [limits.limit.lift_map, limits.limit.lift_map],
    dsimp only [whisker_left, limits.cones.postcompose],
    apply limit.hom_ext,
    intros I,
    dsimp only [nat_trans.comp_app, functor, Profinite.extend, Profinite.change_cone],
    simp_rw [category.assoc, limits.limit.lift_π],
    change _ = _ ≫ limit.π _ _ ≫ _,
    simp_rw [← category.assoc, limits.limit.lift_π],
    dsimp only [nat_trans.comp_app, functor_prod_cone, functor_prod,
      functor.comp_map, uncurry, limits.prod.functor],
    simp only [limits.prod.map_map, category.id_comp, category.comp_id, category.assoc],
    let e : Fintype.of (I.comap f.continuous) ⟶ Fintype.of I := discrete_quotient.map (le_refl _),
    erw ← (Fintype_add_functor r' c₁ c₂).naturality e,
    simp_rw ← category.assoc,
    dsimp only [Fintype_functor_prod, functor.comp_map, uncurry, limits.prod.functor,
      functor.prod, functor, Profinite.extend],
    simp only [limits.prod.map_map, category.id_comp, category.comp_id, limits.limit.lift_π],
    refl,
  end }

/-- The profinite functorial variant of negation on `Lbar_le`. -/
def neg_functor [fact (0 < r')] : functor.{u} r' c ⟶ functor.{u} r' c :=
{ app := λ X, limits.lim.map $ whisker_left _ $ Fintype_neg_functor _ _,
  naturality' := begin
    intros A B f,
    apply limit.hom_ext,
    intros S,
    dsimp,
    simp,
  end }

variables {c₁ c₂}

/-- A bifunctor version of `functor`, where `c` can vary. -/
@[simps]
def bifunctor [fact (0 < r')] : ℝ≥0 ⥤ Profinite.{u} ⥤ Profinite.{u} :=
{ obj := λ c, functor r' c,
  map := λ a b f, Profinite.extend_nat_trans $ (Fintype_bifunctor r').map f,
  map_id' := begin
    intros c,
    rw (Fintype_bifunctor r').map_id,
    exact Profinite.extend_nat_trans_id _,
  end,
  map_comp' := begin
    intros a b c α β,
    rw (Fintype_bifunctor r').map_comp,
    exact Profinite.extend_nat_trans_comp _ _,
  end }

/-- `Lbar_le.functor r' c` is indeed an extension of `Lbar_le.Fintype_functor r' c`. -/
@[simps]
def functor_extends [fact (0 < r')] :
  Fintype.to_Profinite ⋙ functor.{u} r' c ≅ Fintype_functor.{u} r' c :=
Profinite.extend_extends _ .

variables {r' c}

-/

end Lbar_le

instance [fact (0 < r')] : profinitely_filtered_pseudo_normed_group (Lbar r' S) :=
{ topology := λ c, show topological_space (Lbar_le r' S c), by apply_instance,
  t2 := λ c, show t2_space (Lbar_le r' S c), by apply_instance,
  td := λ c, show totally_disconnected_space (Lbar_le r' S c), by apply_instance,
  compact := λ c, show compact_space (Lbar_le r' S c), by apply_instance,
  continuous_add' := λ c₁ c₂, Lbar_le.continuous_add',
  continuous_neg' := λ c, Lbar_le.continuous_neg,
  continuous_cast_le := λ c₁ c₂,
  begin
    introI h,
    rw show pseudo_normed_group.cast_le = (Lbar_le.cast_le : Lbar_le r' S c₁ → Lbar_le r' S c₂),
      by {ext, refl},
    exact Lbar_le.continuous_cast_le r' S c₁ c₂,
  end,
  .. Lbar.pseudo_normed_group }

/-

namespace Lbar

variable r'

/-- The diagram whose colimit yields `Lbar.profinite`. -/
def profinite_diagram [fact (0 < r')] : ℝ≥0 ⥤ Profinite.{u} ⥤ Type u :=
let E := (whiskering_right Profinite _ _).obj (forget Profinite) in
  ((whiskering_right _ _ _).obj E).obj (Lbar_le.bifunctor.{u} r')

/-- The functor `Lbar : Profinite ⥤ Type*`. -/
@[nolint check_univs] -- TODO remove this
def profinite [fact (0 < r')] : Profinite ⥤ Type* :=
(as_small.down ⋙ profinite_diagram r').flip ⋙ colim

attribute [nolint check_univs] profinite._proof_1

-- TODO: Move this to the condensed folder, once it's more stable!
/-- The representable presheaf associated to a profinite set. -/
def representable : Profinite.{u} ⥤ (as_small.{u+1} Profinite.{u})ᵒᵖ ⥤ Type (u+1) :=
let Y := @yoneda (as_small.{u+1} Profinite.{u}) _ in
((whiskering_right Profinite.{u} _ _).obj Y).obj as_small.up

/-- The diagram whose colimit yields `Lbar.precondensed`. -/
def precondensed_diagram [fact (0 < r')] :
  ℝ≥0 ⥤ Profinite.{u} ⥤ (as_small.{u+1} Profinite.{u})ᵒᵖ ⥤ Type (u+1) :=
let E := (whiskering_right Profinite _ _).obj representable in
((whiskering_right _ _ _).obj E).obj $ Lbar_le.bifunctor.{u} r'

/-- A functor associating to every `S : Profinite` the presheaf associated to the condensed set
`Lbar(S)`. -/
-- TODO: Prove that it is a condensed set!
def precondensed [fact (0 < r')] : Profinite.{u} ⥤ (as_small.{u+1} Profinite.{u})ᵒᵖ ⥤ Type (u+1) :=
(as_small.down.{_ _ (u+1)} ⋙ precondensed_diagram.{u} r').flip  ⋙ colim

end Lbar

-/

#lint-


/-
Copyright (c) 2022 Joël Riou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joël Riou
-/

import algebraic_topology.simplicial_object
import category_theory.limits.shapes.images
import for_mathlib.simplex_category.factorisations
import category_theory.limits.shapes.finite_products
import algebraic_topology.simplicial_set
import category_theory.limits.preserves.shapes.products
import algebraic_topology.split_simplicial_object
import for_mathlib.inclusions_mono

noncomputable theory

open category_theory
open category_theory.category
open category_theory.limits
open opposite
open simplex_category
open_locale simplicial

universe u

variables {C : Type*} [category C]

namespace simplicial_object

namespace splitting

namespace index_set

variables {Δ : simplex_categoryᵒᵖ} (A : index_set Δ)

/-
lemma eq_id_iff_len_le : A.eq_id ↔ Δ.unop.len ≤ A.1.unop.len :=
begin
  split,
  { intro h,
    rw eq_id_iff_len_eq at h,
    rw h, },
  { intro h,
    rw eq_id_iff_len_eq,
    refine le_antisymm (len_le_of_epi (infer_instance : epi A.e)) h, },
end

lemma eq_id_iff_mono : A.eq_id ↔ mono A.e :=
begin
  split,
  { intro h,
    dsimp at h,
    subst h,
    dsimp only [id, e],
    apply_instance, },
  { intro h,
    rw eq_id_iff_len_le,
    exact len_le_of_mono h, }
end-/

end index_set

end splitting

end simplicial_object


/-
# A list of all of the attributes that are in Lean that I have encountered.

- `@[elab_as_eliminator]`
- `@[simp]` When a lemma is tagged with `simp`, it becomes available to the `simp [*]` tactic.
- `@[derive decidable_eq]` will automatically ad
- `attribute [pp_using_anonymous_constructor] state_t`. Use this if your structure is a singleton and you want to skip the wrapper when you pretty print.

# A list of all of non-declarations in Lean

- `run_cmd` runs a `tactic _`. The tactic has a single goal `⊢ true`.
- `set_option`
    + `pp.all`
    + ... [TODO] just the useful ones.
- `#check`
- `#eval`
- `#print`

 -/


/-
Copyright (c) 2019 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Simon Hudon, Scott Morrison, Keeley Hoek, Robert Y. Lewis
-/
import data.string.defs
import data.option.defs
import tactic.derive_inhabited
/-!
# Additional operations on expr and related types

This file defines basic operations on the types expr, name, declaration, level, environment.

This file is mostly for non-tactics. Tactics should generally be placed in `tactic.core`.

## Tags

expr, name, declaration, level, environment, meta, metaprogramming, tactic
-/

attribute [derive has_reflect, derive decidable_eq] binder_info congr_arg_kind

@[priority 100] meta instance has_reflect.has_to_pexpr {α} [has_reflect α] : has_to_pexpr α :=
⟨λ b, pexpr.of_expr (reflect b)⟩

namespace binder_info

/-! ### Declarations about `binder_info` -/

instance : inhabited binder_info := ⟨ binder_info.default ⟩

/-- The brackets corresponding to a given binder_info. -/
def brackets : binder_info → string × string
| binder_info.implicit        := ("{", "}")
| binder_info.strict_implicit := ("{{", "}}")
| binder_info.inst_implicit   := ("[", "]")
| _                           := ("(", ")")

end binder_info

namespace name

/-! ### Declarations about `name` -/

/-- Find the largest prefix `n` of a `name` such that `f n ≠ none`, then replace this prefix
with the value of `f n`. -/
def map_prefix (f : name → option name) : name → name
| anonymous := anonymous
| (mk_string s n') := (f (mk_string s n')).get_or_else (mk_string s $ map_prefix n')
| (mk_numeral d n') := (f (mk_numeral d n')).get_or_else (mk_numeral d $ map_prefix n')

/-- If `nm` is a simple name (having only one string component) starting with `_`, then
`deinternalize_field nm` removes the underscore. Otherwise, it does nothing. -/
meta def deinternalize_field : name → name
| (mk_string s name.anonymous) :=
  let i := s.mk_iterator in
  if i.curr = '_' then i.next.next_to_string else s
| n := n

/-- `get_nth_prefix nm n` removes the last `n` components from `nm` -/
meta def get_nth_prefix : name → ℕ → name
| nm 0 := nm
| nm (n + 1) := get_nth_prefix nm.get_prefix n

/-- Auxilliary definition for `pop_nth_prefix` -/
private meta def pop_nth_prefix_aux : name → ℕ → name × ℕ
| anonymous n := (anonymous, 1)
| nm n := let (pfx, height) := pop_nth_prefix_aux nm.get_prefix n in
          if height ≤ n then (anonymous, height + 1)
          else (nm.update_prefix pfx, height + 1)

/-- Pops the top `n` prefixes from the given name. -/
meta def pop_nth_prefix (nm : name) (n : ℕ) : name :=
prod.fst $ pop_nth_prefix_aux nm n

/-- Pop the prefix of a name -/
meta def pop_prefix (n : name) : name :=
pop_nth_prefix n 1

/-- Auxilliary definition for `from_components` -/
private def from_components_aux : name → list string → name
| n [] := n
| n (s :: rest) := from_components_aux (name.mk_string s n) rest

/-- Build a name from components. For example `from_components ["foo","bar"]` becomes
  ``` `foo.bar``` -/
def from_components : list string → name :=
from_components_aux name.anonymous

/-- `name`s can contain numeral pieces, which are not legal names
  when typed/passed directly to the parser. We turn an arbitrary
  name into a legal identifier name by turning the numbers to strings. -/
meta def sanitize_name : name → name
| name.anonymous := name.anonymous
| (name.mk_string s p) := name.mk_string s $ sanitize_name p
| (name.mk_numeral s p) := name.mk_string sformat!"n{s}" $ sanitize_name p

/-- Append a string to the last component of a name -/
def append_suffix : name → string → name
| (mk_string s n) s' := mk_string (s ++ s') n
| n _ := n

/-- The first component of a name, turning a number to a string -/
meta def head : name → string
| (mk_string s anonymous) := s
| (mk_string s p)         := head p
| (mk_numeral n p)        := head p
| anonymous               := "[anonymous]"

/-- Tests whether the first component of a name is `"_private"` -/
meta def is_private (n : name) : bool :=
n.head = "_private"

/-- Get the last component of a name, and convert it to a string. -/
meta def last : name → string
| (mk_string s _)  := s
| (mk_numeral n _) := repr n
| anonymous        := "[anonymous]"

/-- Returns the number of characters used to print all the string components of a name,
  including periods between name segments. Ignores numerical parts of a name. -/
meta def length : name → ℕ
| (mk_string s anonymous) := s.length
| (mk_string s p)         := s.length + 1 + p.length
| (mk_numeral n p)        := p.length
| anonymous               := "[anonymous]".length

/-- Checks whether `nm` has a prefix (including itself) such that P is true -/
def has_prefix (P : name → bool) : name → bool
| anonymous := ff
| (mk_string s nm)  := P (mk_string s nm) ∨ has_prefix nm
| (mk_numeral s nm) := P (mk_numeral s nm) ∨ has_prefix nm

/-- Appends `'` to the end of a name. -/
meta def add_prime : name → name
| (name.mk_string s p) := name.mk_string (s ++ "'") p
| n := (name.mk_string "x'" n)

/-- `last_string n` returns the rightmost component of `n`, ignoring numeral components.
For example, ``last_string `a.b.c.33`` will return `` `c ``. -/
def last_string : name → string
| anonymous        := "[anonymous]"
| (mk_string s _)  := s
| (mk_numeral _ n) := last_string n

/--
Constructs a (non-simple) name from a string.

Example: ``name.from_string "foo.bar" = `foo.bar``
-/
meta def from_string (s : string) : name :=
from_components $ s.split (= '.')

/--
In surface Lean, we can write anonymous Π binders (i.e. binders where the
argument is not named) using the function arrow notation:

```lean
inductive test : Type
| intro : unit → test
```

After elaboration, however, every binder must have a name, so Lean generates
one. In the example, the binder in the type of `intro` is anonymous, so Lean
gives it the name `ᾰ`:

```lean
test.intro : ∀ (ᾰ : unit), test
```

When there are multiple anonymous binders, they are named `ᾰ_1`, `ᾰ_2` etc.

Thus, when we want to know whether the user named a binder, we can check whether
the name follows this scheme. Note, however, that this is not reliable. When the
user writes (for whatever reason)

```lean
inductive test : Type
| intro : ∀ (ᾰ : unit), test
```

we cannot tell that the binder was, in fact, named.

The function `name.is_likely_generated_binder_name` checks if
a name is of the form `ᾰ`, `ᾰ_1`, etc.
-/
library_note "likely generated binder names"

/--
Check whether a simple name was likely generated by Lean to name an anonymous
binder. Such names are either `ᾰ` or `ᾰ_n` for some natural `n`. See
note [likely generated binder names].
-/
meta def is_likely_generated_binder_simple_name : string → bool
| "ᾰ" := tt
| n :=
  match n.get_rest "ᾰ_" with
  | none := ff
  | some suffix := suffix.is_nat
  end

/--
Check whether a name was likely generated by Lean to name an anonymous binder.
Such names are either `ᾰ` or `ᾰ_n` for some natural `n`. See
note [likely generated binder names].
-/
meta def is_likely_generated_binder_name (n : name) : bool :=
match n with
| mk_string s anonymous := is_likely_generated_binder_simple_name s
| _ := ff
end

end name

namespace level

/-! ### Declarations about `level` -/

/-- Tests whether a universe level is non-zero for all assignments of its variables -/
meta def nonzero : level → bool
| (succ _) := tt
| (max l₁ l₂) := l₁.nonzero || l₂.nonzero
| (imax _ l₂) := l₂.nonzero
| _ := ff

/--
`l.fold_mvar f` folds a function `f : name → α → α`
over each `n : name` appearing in a `level.mvar n` in `l`.
-/
meta def fold_mvar {α} : level → (name → α → α) → α → α
| zero f := id
| (succ a) f := fold_mvar a f
| (param a) f := id
| (mvar a) f := f a
| (max a b) f := fold_mvar a f ∘ fold_mvar b f
| (imax a b) f := fold_mvar a f ∘ fold_mvar b f

end level

/-! ### Declarations about `binder` -/

/-- The type of binders containing a name, the binding info and the binding type -/
@[derive decidable_eq, derive inhabited]
meta structure binder :=
  (name : name)
  (info : binder_info)
  (type : expr)

namespace binder
/-- Turn a binder into a string. Uses expr.to_string for the type. -/
protected meta def to_string (b : binder) : string :=
let (l, r) := b.info.brackets in
l ++ b.name.to_string ++ " : " ++ b.type.to_string ++ r

open tactic
meta instance : has_to_string binder := ⟨ binder.to_string ⟩
meta instance : has_to_format binder := ⟨ λ b, b.to_string ⟩
meta instance : has_to_tactic_format binder :=
⟨ λ b, let (l, r) := b.info.brackets in
  (λ e, l ++ b.name.to_string ++ " : " ++ e ++ r) <$> pp b.type ⟩

end binder

/-!
### Converting between expressions and numerals

There are a number of ways to convert between expressions and numerals, depending on the input and
output types and whether you want to infer the necessary type classes.

See also the tactics `expr.of_nat`, `expr.of_int`, `expr.of_rat`.
-/

/--
`nat.mk_numeral n` embeds `n` as a numeral expression inside a type with 0, 1, and +.
`type`: an expression representing the target type. This must live in Type 0.
`has_zero`, `has_one`, `has_add`: expressions of the type `has_zero %%type`, etc.
 -/
meta def nat.mk_numeral (type has_zero has_one has_add : expr) : ℕ → expr :=
let z : expr := `(@has_zero.zero.{0} %%type %%has_zero),
    o : expr := `(@has_one.one.{0} %%type %%has_one) in
nat.binary_rec z
  (λ b n e, if n = 0 then o else
    if b then `(@bit1.{0} %%type %%has_one %%has_add %%e)
    else `(@bit0.{0} %%type %%has_add %%e))

/--
`int.mk_numeral z` embeds `z` as a numeral expression inside a type with 0, 1, +, and -.
`type`: an expression representing the target type. This must live in Type 0.
`has_zero`, `has_one`, `has_add`, `has_neg`: expressions of the type `has_zero %%type`, etc.
 -/
meta def int.mk_numeral (type has_zero has_one has_add has_neg : expr) : ℤ → expr
| (int.of_nat n) := n.mk_numeral type has_zero has_one has_add
| -[1+n] := let ne := (n+1).mk_numeral type has_zero has_one has_add in
            `(@has_neg.neg.{0} %%type %%has_neg %%ne)

/--
`nat.to_pexpr n` creates a `pexpr` that will evaluate to `n`.
The `pexpr` does not hold any typing information:
`to_expr ``((%%(nat.to_pexpr 5) : ℤ))` will create a native integer numeral `(5 : ℤ)`.
-/
meta def nat.to_pexpr : ℕ → pexpr
| 0 := ``(0)
| 1 := ``(1)
| n := if n % 2 = 0 then ``(bit0 %%(nat.to_pexpr (n/2))) else ``(bit1 %%(nat.to_pexpr (n/2)))
namespace expr

/--
Turns an expression into a natural number, assuming it is only built up from
`has_one.one`, `bit0`, `bit1`, `has_zero.zero`, `nat.zero`, and `nat.succ`.
-/
protected meta def to_nat : expr → option ℕ
| `(has_zero.zero) := some 0
| `(has_one.one) := some 1
| `(bit0 %%e) := bit0 <$> e.to_nat
| `(bit1 %%e) := bit1 <$> e.to_nat
| `(nat.succ %%e) := (+1) <$> e.to_nat
| `(nat.zero) := some 0
| _ := none

/--
Turns an expression into a integer, assuming it is only built up from
`has_one.one`, `bit0`, `bit1`, `has_zero.zero` and a optionally a single `has_neg.neg` as head.
-/
protected meta def to_int : expr → option ℤ
| `(has_neg.neg %%e) := do n ← e.to_nat, some (-n)
| e                  := coe <$> e.to_nat

/--
`is_num_eq n1 n2` returns true if `n1` and `n2` are both numerals with the same numeral structure,
ignoring differences in type and type class arguments.
-/
meta def is_num_eq : expr → expr → bool
| `(@has_zero.zero _ _) `(@has_zero.zero _ _) := tt
| `(@has_one.one _ _) `(@has_one.one _ _) := tt
| `(bit0 %%a) `(bit0 %%b) := a.is_num_eq b
| `(bit1 %%a) `(bit1 %%b) := a.is_num_eq b
| `(-%%a) `(-%%b) := a.is_num_eq b
| `(%%a/%%a') `(%%b/%%b') :=  a.is_num_eq b
| _ _ := ff

end expr

/-! ### Declarations about `expr` -/

namespace expr
open tactic

/-- List of names removed by `clean`. All these names must resolve to functions defeq `id`. -/
meta def clean_ids : list name :=
[``id, ``id_rhs, ``id_delta, ``hidden]

/-- Clean an expression by removing `id`s listed in `clean_ids`. -/
meta def clean (e : expr) : expr :=
e.replace (λ e n,
     match e with
     | (app (app (const n _) _) e') :=
       if n ∈ clean_ids then some e' else none
     | (app (lam _ _ _ (var 0)) e') := some e'
     | _ := none
     end)

/-- `replace_with e s s'` replaces ocurrences of `s` with `s'` in `e`. -/
meta def replace_with (e : expr) (s : expr) (s' : expr) : expr :=
e.replace $ λc d, if c = s then some (s'.lift_vars 0 d) else none

/-- Apply a function to each constant (inductive type, defined function etc) in an expression. -/
protected meta def apply_replacement_fun (f : name → name) (e : expr) : expr :=
e.replace $ λ e d,
  match e with
  | expr.const n ls := some $ expr.const (f n) ls
  | _ := none
  end

/-- Implementation of `expr.mreplace`. -/
meta def mreplace_aux {m : Type* → Type*} [monad m] (R : expr → nat → m (option expr)) :
  expr → ℕ → m expr
| (app f x) n := option.mget_or_else (R (app f x) n)
  (do Rf ← mreplace_aux f n, Rx ← mreplace_aux x n, return $ app Rf Rx)
| (lam nm bi ty bd) n := option.mget_or_else (R (lam nm bi ty bd) n)
  (do Rty ← mreplace_aux ty n, Rbd ← mreplace_aux bd (n+1), return $ lam nm bi Rty Rbd)
| (pi nm bi ty bd) n := option.mget_or_else (R (pi nm bi ty bd) n)
  (do Rty ← mreplace_aux ty n, Rbd ← mreplace_aux bd (n+1), return $ pi nm bi Rty Rbd)
| (elet nm ty a b) n := option.mget_or_else (R (elet nm ty a b) n)
  (do Rty ← mreplace_aux ty n,
    Ra ← mreplace_aux a n,
    Rb ← mreplace_aux b n,
    return $ elet nm Rty Ra Rb)
| e n := option.mget_or_else (R e n) (return e)

/--
Monadic analogue of `expr.replace`.

The `mreplace R e` visits each subexpression `s` of `e`, and is called with `R s n`, where
`n` is the number of binders above `e`.
If `R s n` fails, the whole replacement fails.
If `R s n` returns `some t`, `s` is replaced with `t` (and `mreplace` does not visit
its subexpressions).
If `R s n` return `none`, then `mreplace` continues visiting subexpressions of `s`.
-/
meta def mreplace {m : Type* → Type*} [monad m] (R : expr → nat → m (option expr)) (e : expr) :
  m expr :=
mreplace_aux R e 0

/-- Match a variable. -/
meta def match_var {elab} : expr elab → option ℕ
| (var n) := some n
| _ := none

/-- Match a sort. -/
meta def match_sort {elab} : expr elab → option level
| (sort u) := some u
| _ := none

/-- Match a constant. -/
meta def match_const {elab} : expr elab → option (name × list level)
| (const n lvls) := some (n, lvls)
| _ := none

/-- Match a metavariable. -/
meta def match_mvar {elab} : expr elab →
  option (name × name × expr elab)
| (mvar unique pretty type) := some (unique, pretty, type)
| _ := none

/-- Match a local constant. -/
meta def match_local_const {elab} : expr elab →
  option (name × name × binder_info × expr elab)
| (local_const unique pretty bi type) := some (unique, pretty, bi, type)
| _ := none

/-- Match an application. -/
meta def match_app {elab} : expr elab → option (expr elab × expr elab)
| (app t u) := some (t, u)
| _ := none

/-- Match an application of `coe_fn`. -/
meta def match_app_coe_fn : expr → option (expr × expr × expr × expr)
| (app `(@coe_fn %%α %%inst %%fexpr) x) := some (α, inst, fexpr, x)
| _ := none

/-- Match an abstraction. -/
meta def match_lam {elab} : expr elab →
  option (name × binder_info × expr elab × expr elab)
| (lam var_name bi type body) := some (var_name, bi, type, body)
| _ := none

/-- Match a Π type. -/
meta def match_pi {elab} : expr elab →
  option (name × binder_info × expr elab × expr elab)
| (pi var_name bi type body) := some (var_name, bi, type, body)
| _ := none

/-- Match a let. -/
meta def match_elet {elab} : expr elab →
  option (name × expr elab × expr elab × expr elab)
| (elet var_name type assignment body) := some (var_name, type, assignment, body)
| _ := none

/-- Match a macro. -/
meta def match_macro {elab} : expr elab →
  option (macro_def × list (expr elab))
| (macro df args) := some (df, args)
| _ := none

/-- Tests whether an expression is a meta-variable. -/
meta def is_mvar : expr → bool
| (mvar _ _ _) := tt
| _            := ff

/-- Tests whether an expression is a sort. -/
meta def is_sort : expr → bool
| (sort _) := tt
| e         := ff

/-- Get the universe levels of a `const` expression -/
meta def univ_levels : expr → list level
| (const n ls) := ls
| _            := []

/--
Replace any metavariables in the expression with underscores, in preparation for printing
`refine ...` statements.
-/
meta def replace_mvars (e : expr) : expr :=
e.replace (λ e' _, if e'.is_mvar then some (unchecked_cast pexpr.mk_placeholder) else none)

/-- If `e` is a local constant, `to_implicit_local_const e` changes the binder info of `e` to
 `implicit`. See also `to_implicit_binder`, which also changes lambdas and pis. -/
meta def to_implicit_local_const : expr → expr
| (expr.local_const uniq n bi t) := expr.local_const uniq n binder_info.implicit t
| e := e

/-- If `e` is a local constant, lamda, or pi expression, `to_implicit_binder e` changes the binder
info of `e` to `implicit`. See also `to_implicit_local_const`, which only changes local constants.
-/
meta def to_implicit_binder : expr → expr
| (local_const n₁ n₂ _ d) := local_const n₁ n₂ binder_info.implicit d
| (lam n _ d b) := lam n binder_info.implicit d b
| (pi n _ d b) := pi n binder_info.implicit d b
| e  := e

/-- Returns a list of all local constants in an expression (without duplicates). -/
meta def list_local_consts (e : expr) : list expr :=
e.fold [] (λ e' _ es, if e'.is_local_constant then insert e' es else es)

/-- Returns the set of all local constants in an expression. -/
meta def list_local_consts' (e : expr) : expr_set :=
e.fold mk_expr_set (λ e' _ es, if e'.is_local_constant then es.insert e' else es)

/-- Returns the unique names of all local constants in an expression. -/
meta def list_local_const_unique_names (e : expr) : name_set :=
e.fold mk_name_set
  (λ e' _ es, if e'.is_local_constant then es.insert e'.local_uniq_name else es)

/-- Returns a name_set of all constants in an expression. -/
meta def list_constant (e : expr) : name_set :=
e.fold mk_name_set (λ e' _ es, if e'.is_constant then es.insert e'.const_name else es)

/-- Returns a list of all meta-variables in an expression (without duplicates). -/
meta def list_meta_vars (e : expr) : list expr :=
e.fold [] (λ e' _ es, if e'.is_mvar then insert e' es else es)

/-- Returns the set of all meta-variables in an expression. -/
meta def list_meta_vars' (e : expr) : expr_set :=
e.fold mk_expr_set (λ e' _ es, if e'.is_mvar then es.insert e' else es)

/-- Returns a list of all universe meta-variables in an expression (without duplicates). -/
meta def list_univ_meta_vars (e : expr) : list name :=
native.rb_set.to_list $ e.fold native.mk_rb_set $ λ e' i s,
match e' with
| (sort u) := u.fold_mvar (flip native.rb_set.insert) s
| (const _ ls) := ls.foldl (λ s' l, l.fold_mvar (flip native.rb_set.insert) s') s
| _ := s
end

/--
Test `t` contains the specified subexpression `e`, or a metavariable.
This represents the notion that `e` "may occur" in `t`,
possibly after subsequent unification.
-/
meta def contains_expr_or_mvar (t : expr) (e : expr) : bool :=
-- We can't use `t.has_meta_var` here, as that detects universe metavariables, too.
¬ t.list_meta_vars.empty ∨ e.occurs t

/-- Returns a name_set of all constants in an expression starting with a certain prefix. -/
meta def list_names_with_prefix (pre : name) (e : expr) : name_set :=
e.fold mk_name_set $ λ e' _ l,
  match e' with
  | expr.const n _ := if n.get_prefix = pre then l.insert n else l
  | _ := l
  end

/-- Returns true if `e` contains a name `n` where `p n` is true.
  Returns `true` if `p name.anonymous` is true. -/
meta def contains_constant (e : expr) (p : name → Prop) [decidable_pred p] : bool :=
e.fold ff (λ e' _ b, if p (e'.const_name) then tt else b)

/--
Returns true if `e` contains a `sorry`.
-/
meta def contains_sorry (e : expr) : bool :=
e.fold ff (λ e' _ b, if (is_sorry e').is_some then tt else b)

/--
`app_symbol_in e l` returns true iff `e` is an application of a constant whose name is in `l`.
-/
meta def app_symbol_in (e : expr) (l : list name) : bool :=
match e.get_app_fn with
| (expr.const n _) := n ∈ l
| _ := ff
end

/-- `get_simp_args e` returns the arguments of `e` that simp can reach via congruence lemmas. -/
meta def get_simp_args (e : expr) : tactic (list expr) :=
-- `mk_specialized_congr_lemma_simp` throws an assertion violation if its argument is not an app
if ¬ e.is_app then pure [] else do
cgr ← mk_specialized_congr_lemma_simp e,
pure $ do
  (arg_kind, arg) ← cgr.arg_kinds.zip e.get_app_args,
  guard $ arg_kind = congr_arg_kind.eq,
  pure arg

/-- Simplifies the expression `t` with the specified options.
  The result is `(new_e, pr)` with the new expression `new_e` and a proof
  `pr : e = new_e`. -/
meta def simp (t : expr)
  (cfg : simp_config := {}) (discharger : tactic unit := failed)
  (no_defaults := ff) (attr_names : list name := []) (hs : list simp_arg_type := []) :
  tactic (expr × expr × name_set) :=
do (s, to_unfold) ← mk_simp_set no_defaults attr_names hs,
   simplify s to_unfold t cfg `eq discharger

/-- Definitionally simplifies the expression `t` with the specified options.
  The result is the simplified expression. -/
meta def dsimp (t : expr)
  (cfg : dsimp_config := {})
  (no_defaults := ff) (attr_names : list name := []) (hs : list simp_arg_type := []) :
  tactic expr :=
do (s, to_unfold) ← mk_simp_set no_defaults attr_names hs,
   s.dsimplify to_unfold t cfg

/-- Get the names of the bound variables by a sequence of pis or lambdas. -/
meta def binding_names : expr → list name
| (pi n _ _ e)  := n :: e.binding_names
| (lam n _ _ e) := n :: e.binding_names
| e             := []

/-- head-reduce a single let expression -/
meta def reduce_let : expr → expr
| (elet _ _ v b) := b.instantiate_var v
| e              := e

/-- head-reduce all let expressions -/
meta def reduce_lets : expr → expr
| (elet _ _ v b) := reduce_lets $ b.instantiate_var v
| e              := e

/-- Instantiate lambdas in the second argument by expressions from the first. -/
meta def instantiate_lambdas : list expr → expr → expr
| (e'::es) (lam n bi t e) := instantiate_lambdas es (e.instantiate_var e')
| _        e              := e

/-- Repeatedly apply `expr.subst`. -/
meta def substs : expr → list expr → expr | e es := es.foldl expr.subst e

/-- `instantiate_lambdas_or_apps es e` instantiates lambdas in `e` by expressions from `es`.
If the length of `es` is larger than the number of lambdas in `e`,
then the term is applied to the remaining terms.
Also reduces head let-expressions in `e`, including those after instantiating all lambdas.

This is very similar to `expr.substs`, but this also reduces head let-expressions. -/
meta def instantiate_lambdas_or_apps : list expr → expr → expr
| (v::es) (lam n bi t b) := instantiate_lambdas_or_apps es $ b.instantiate_var v
| es      (elet _ _ v b) := instantiate_lambdas_or_apps es $ b.instantiate_var v
| es      e              := mk_app e es

/--
Some declarations work with open expressions, i.e. an expr that has free variables.
Terms will free variables are not well-typed, and one should not use them in tactics like
`infer_type` or `unify`. You can still do syntactic analysis/manipulation on them.
The reason for working with open types is for performance: instantiating variables requires
iterating through the expression. In one performance test `pi_binders` was more than 6x
quicker than `mk_local_pis` (when applied to the type of all imported declarations 100x).
-/
library_note "open expressions"

/-- Get the codomain/target of a pi-type.
  This definition doesn't instantiate bound variables, and therefore produces a term that is open.
  See note [open expressions]. -/
meta def pi_codomain : expr → expr
| (pi n bi d b) := pi_codomain b
| e             := e

/-- Get the body/value of a lambda-expression.
  This definition doesn't instantiate bound variables, and therefore produces a term that is open.
  See note [open expressions]. -/
meta def lambda_body : expr → expr
| (lam n bi d b) := lambda_body b
| e             := e

/-- Auxilliary defintion for `pi_binders`.
  See note [open expressions]. -/
meta def pi_binders_aux : list binder → expr → list binder × expr
| es (pi n bi d b) := pi_binders_aux (⟨n, bi, d⟩::es) b
| es e             := (es, e)

/-- Get the binders and codomain of a pi-type.
  This definition doesn't instantiate bound variables, and therefore produces a term that is open.
  The.tactic `get_pi_binders` in `tactic.core` does the same, but also instantiates the
  free variables.
  See note [open expressions]. -/
meta def pi_binders (e : expr) : list binder × expr :=
let (es, e) := pi_binders_aux [] e in (es.reverse, e)

/-- Auxilliary defintion for `get_app_fn_args`. -/
meta def get_app_fn_args_aux : list expr → expr → expr × list expr
| r (app f a) := get_app_fn_args_aux (a::r) f
| r e         := (e, r)

/-- A combination of `get_app_fn` and `get_app_args`: lists both the
  function and its arguments of an application -/
meta def get_app_fn_args : expr → expr × list expr :=
get_app_fn_args_aux []

/-- `drop_pis es e` instantiates the pis in `e` with the expressions from `es`. -/
meta def drop_pis : list expr → expr → tactic expr
| (list.cons v vs) (pi n bi d b) := do
  t ← infer_type v,
  guard (t =ₐ d),
  drop_pis vs (b.instantiate_var v)
| [] e := return e
| _  _ := failed

/-- `mk_op_lst op empty [x1, x2, ...]` is defined as `op x1 (op x2 ...)`.
  Returns `empty` if the list is empty. -/
meta def mk_op_lst (op : expr) (empty : expr) : list expr → expr
| []        := empty
| [e]       := e
| (e :: es) := op e $ mk_op_lst es

/-- `mk_and_lst [x1, x2, ...]` is defined as `x1 ∧ (x2 ∧ ...)`, or `true` if the list is empty. -/
meta def mk_and_lst : list expr → expr := mk_op_lst `(and) `(true)

/-- `mk_or_lst [x1, x2, ...]` is defined as `x1 ∨ (x2 ∨ ...)`, or `false` if the list is empty. -/
meta def mk_or_lst : list expr → expr := mk_op_lst `(or) `(false)

/-- `local_binding_info e` returns the binding info of `e` if `e` is a local constant.
Otherwise returns `binder_info.default`. -/
meta def local_binding_info : expr → binder_info
| (expr.local_const _ _ bi _) := bi
| _ := binder_info.default

/-- `is_default_local e` tests whether `e` is a local constant with binder info
`binder_info.default` -/
meta def is_default_local : expr → bool
| (expr.local_const _ _ binder_info.default _) := tt
| _ := ff

/-- `has_local_constant e l` checks whether local constant `l` occurs in expression `e` -/
meta def has_local_constant (e l : expr) : bool :=
e.has_local_in $ mk_name_set.insert l.local_uniq_name

/-- Turns a local constant into a binder -/
meta def to_binder : expr → binder
| (local_const _ nm bi t) := ⟨nm, bi, t⟩
| _                       := default binder

/-- Strip-away the context-dependent unique id for the given local const and return: its friendly
`name`, its `binder_info`, and its `type : expr`. -/
meta def get_local_const_kind : expr → name × binder_info × expr
| (expr.local_const _ n bi e) := (n, bi, e)
| _ := (name.anonymous, binder_info.default, expr.const name.anonymous [])

/-- `local_const_set_type e t` sets the type of `e` to `t`, if `e` is a `local_const`. -/
meta def local_const_set_type {elab : bool} : expr elab → expr elab → expr elab
| (expr.local_const x n bi t) new_t := expr.local_const x n bi new_t
| e                           new_t := e

/-- `unsafe_cast e` freely changes the `elab : bool` parameter of the passed `expr`. Mainly used to
access core `expr` manipulation functions for `pexpr`-based use, but which are restricted to
`expr tt` at the site of definition unnecessarily.

DANGER: Unless you know exactly what you are doing, this is probably not the function you are
looking for. For `pexpr → expr` see `tactic.to_expr`. For `expr → pexpr` see `to_pexpr`. -/
meta def unsafe_cast {elab₁ elab₂ : bool} : expr elab₁ → expr elab₂ := unchecked_cast

/-- `replace_subexprs e mappings` takes an `e : expr` and interprets a `list (expr × expr)` as
a collection of rules for variable replacements. A pair `(f, t)` encodes a rule which says "whenever
`f` is encountered in `e` verbatim, replace it with `t`". -/
meta def replace_subexprs {elab : bool} (e : expr elab) (mappings : list (expr × expr)) :
  expr elab :=
unsafe_cast $ e.unsafe_cast.replace $ λ e n,
  (mappings.filter $ λ ent : expr × expr, ent.1 = e).head'.map prod.snd

/-- `is_implicitly_included_variable e vs` accepts `e`, an `expr.local_const`, and a list `vs` of
    other `expr.local_const`s. It determines whether `e` should be considered "available in context"
    as a variable by virtue of the fact that the variables `vs` have been deemed such.

    For example, given `variables (n : ℕ) [prime n] [ih : even n]`, a reference to `n` implies that
    the typeclass instance `prime n` should be included, but `ih : even n` should not.

    DANGER: It is possible that for `f : expr` another `expr.local_const`, we have
    `is_implicitly_included_variable f vs = ff` but
    `is_implicitly_included_variable f (e :: vs) = tt`. This means that one usually wants to
    iteratively add a list of local constants (usually, the `variables` declared in the local scope)
    which satisfy `is_implicitly_included_variable` to an initial `vs`, repeating if any variables
    were added in a particular iteration. The function `all_implicitly_included_variables` below
    implements this behaviour.

    Note that if `e ∈ vs` then `is_implicitly_included_variable e vs = tt`. -/
meta def is_implicitly_included_variable (e : expr) (vs : list expr) : bool :=
if ¬(e.local_pp_name.to_string.starts_with "_") then
  e ∈ vs
else e.local_type.fold tt $ λ se _ b,
  if ¬b then ff
  else if ¬se.is_local_constant then tt
  else se ∈ vs

/-- Private work function for `all_implicitly_included_variables`, performing the actual series of
    iterations, tracking with a boolean whether any updates occured this iteration. -/
private meta def all_implicitly_included_variables_aux
  : list expr → list expr → list expr → bool → list expr
| []          vs rs tt := all_implicitly_included_variables_aux rs vs [] ff
| []          vs rs ff := vs
| (e :: rest) vs rs b :=
  let (vs, rs, b) :=
    if e.is_implicitly_included_variable vs then (e :: vs, rs, tt) else (vs, e :: rs, b) in
  all_implicitly_included_variables_aux rest vs rs b

/-- `all_implicitly_included_variables es vs` accepts `es`, a list of `expr.local_const`, and `vs`,
    another such list. It returns a list of all variables `e` in `es` or `vs` for which an inclusion
    of the variables in `vs` into the local context implies that `e` should also be included. See
    `is_implicitly_included_variable e vs` for the details.

    In particular, those elements of `vs` are included automatically. -/
meta def all_implicitly_included_variables (es vs : list expr) : list expr :=
all_implicitly_included_variables_aux es vs [] ff

end expr

/-! ### Declarations about `environment` -/

namespace environment

/-- Tests whether `n` is a structure. -/
meta def is_structure (env : environment) (n : name) : bool :=
(env.structure_fields n).is_some

/-- Get the full names of all projections of the structure `n`. Returns `none` if `n` is not a
  structure. -/
meta def structure_fields_full (env : environment) (n : name) : option (list name) :=
(env.structure_fields n).map (list.map $ λ n', n ++ n')

/-- Tests whether `nm` is a generalized inductive type that is not a normal inductive type.
  Note that `is_ginductive` returns `tt` even on regular inductive types.
  This returns `tt` if `nm` is (part of a) mutually defined inductive type or a nested inductive
  type. -/
meta def is_ginductive' (e : environment) (nm : name) : bool :=
e.is_ginductive nm ∧ ¬ e.is_inductive nm

/-- For all declarations `d` where `f d = some x` this adds `x` to the returned list.  -/
meta def decl_filter_map {α : Type} (e : environment) (f : declaration → option α) : list α :=
  e.fold [] $ λ d l, match f d with
                     | some r := r :: l
                     | none := l
                     end

/-- Maps `f` to all declarations in the environment. -/
meta def decl_map {α : Type} (e : environment) (f : declaration → α) : list α :=
  e.decl_filter_map $ λ d, some (f d)

/-- Lists all declarations in the environment -/
meta def get_decls (e : environment) : list declaration :=
  e.decl_map id

/-- Lists all trusted (non-meta) declarations in the environment -/
meta def get_trusted_decls (e : environment) : list declaration :=
  e.decl_filter_map (λ d, if d.is_trusted then some d else none)

/-- Lists the name of all declarations in the environment -/
meta def get_decl_names (e : environment) : list name :=
  e.decl_map declaration.to_name

/-- Fold a monad over all declarations in the environment. -/
meta def mfold {α : Type} {m : Type → Type} [monad m] (e : environment) (x : α)
  (fn : declaration → α → m α) : m α :=
e.fold (return x) (λ d t, t >>= fn d)

/-- Filters all declarations in the environment. -/
meta def filter (e : environment) (test : declaration → bool) : list declaration :=
e.fold [] $ λ d ds, if test d then d::ds else ds

/-- Filters all declarations in the environment. -/
meta def mfilter (e : environment) (test : declaration → tactic bool) : tactic (list declaration) :=
e.mfold [] $ λ d ds, do b ← test d, return $ if b then d::ds else ds

/-- Checks whether `s` is a prefix of the file where `n` is declared.
  This is used to check whether `n` is declared in mathlib, where `s` is the mathlib directory. -/
meta def is_prefix_of_file (e : environment) (s : string) (n : name) : bool :=
s.is_prefix_of $ (e.decl_olean n).get_or_else ""

end environment

/-!
### `is_eta_expansion`

 In this section we define the tactic `is_eta_expansion` which checks whether an expression
  is an eta-expansion of a structure. (not to be confused with eta-expanion for `λ`).

-/

namespace expr

open tactic

/-- `is_eta_expansion_of args univs l` checks whether for all elements `(nm, pr)` in `l` we have
  `pr = nm.{univs} args`.
  Used in `is_eta_expansion`, where `l` consists of the projections and the fields of the value we
  want to eta-reduce. -/
meta def is_eta_expansion_of (args : list expr) (univs : list level) (l : list (name × expr)) :
  bool :=
l.all $ λ⟨proj, val⟩, val = (const proj univs).mk_app args

/-- `is_eta_expansion_test l` checks whether there is a list of expresions `args` such that for all
  elements `(nm, pr)` in `l` we have `pr = nm args`. If so, returns the last element of `args`.
  Used in `is_eta_expansion`, where `l` consists of the projections and the fields of the value we
  want to eta-reduce. -/
meta def is_eta_expansion_test : list (name × expr) → option expr
| []              := none
| (⟨proj, val⟩::l) :=
  match val.get_app_fn with
  | (const nm univs : expr) :=
    if nm = proj then
      let args := val.get_app_args in
      let e := args.ilast in
      if is_eta_expansion_of args univs l then some e else none
    else
      none
  | _                       := none
  end

/-- `is_eta_expansion_aux val l` checks whether `val` can be eta-reduced to an expression `e`.
  Here `l` is intended to consists of the projections and the fields of `val`.
  This tactic calls `is_eta_expansion_test l`, but first removes all proofs from the list `l` and
  afterward checks whether the resulting expression `e` unifies with `val`.
  This last check is necessary, because `val` and `e` might have different types. -/
meta def is_eta_expansion_aux (val : expr) (l : list (name × expr)) : tactic (option expr) :=
do l' ← l.mfilter (λ⟨proj, val⟩, bnot <$> is_proof val),
  match is_eta_expansion_test l' with
  | some e := option.map (λ _, e) <$> try_core (unify e val)
  | none   := return none
  end

/-- `is_eta_expansion val` checks whether there is an expression `e` such that `val` is the
  eta-expansion of `e`.
  With eta-expansion we here mean the eta-expansion of a structure, not of a function.
  For example, the eta-expansion of `x : α × β` is `⟨x.1, x.2⟩`.
  This assumes that `val` is a fully-applied application of the constructor of a structure.

  This is useful to reduce expressions generated by the notation
    `{ field_1 := _, ..other_structure }`
  If `other_structure` is itself a field of the structure, then the elaborator will insert an
  eta-expanded version of `other_structure`. -/
meta def is_eta_expansion (val : expr) : tactic (option expr) := do
  e ← get_env,
  type ← infer_type val,
  projs ← e.structure_fields_full type.get_app_fn.const_name,
  let args := (val.get_app_args).drop type.get_app_args.length,
  is_eta_expansion_aux val (projs.zip args)

end expr

/-! ### Declarations about `declaration` -/

namespace declaration
open tactic

/--
`declaration.update_with_fun f tgt decl`
sets the name of the given `decl : declaration` to `tgt`, and applies `f` to the names
of all `expr.const`s which appear in the value or type of `decl`.
-/
protected meta def update_with_fun (f : name → name) (tgt : name) (decl : declaration) :
  declaration :=
let decl := decl.update_name $ tgt in
let decl := decl.update_type $ decl.type.apply_replacement_fun f in
decl.update_value $ decl.value.apply_replacement_fun f

/-- Checks whether the declaration is declared in the current file.
  This is a simple wrapper around `environment.in_current_file`
  Use `environment.in_current_file` instead if performance matters. -/
meta def in_current_file (d : declaration) : tactic bool :=
do e ← get_env, return $ e.in_current_file d.to_name

/-- Checks whether a declaration is a theorem -/
meta def is_theorem : declaration → bool
| (thm _ _ _ _) := tt
| _             := ff

/-- Checks whether a declaration is a constant -/
meta def is_constant : declaration → bool
| (cnst _ _ _ _) := tt
| _              := ff

/-- Checks whether a declaration is a axiom -/
meta def is_axiom : declaration → bool
| (ax _ _ _) := tt
| _          := ff

/-- Checks whether a declaration is automatically generated in the environment.
  There is no cheap way to check whether a declaration in the namespace of a generalized
  inductive type is automatically generated, so for now we say that all of them are automatically
  generated. -/
meta def is_auto_generated (e : environment) (d : declaration) : bool :=
e.is_constructor d.to_name ∨
(e.is_projection d.to_name).is_some ∨
(e.is_constructor d.to_name.get_prefix ∧
  d.to_name.last ∈ ["inj", "inj_eq", "sizeof_spec", "inj_arrow"]) ∨
(e.is_inductive d.to_name.get_prefix ∧
  d.to_name.last ∈ ["below", "binduction_on", "brec_on", "cases_on", "dcases_on", "drec_on", "drec",
  "rec", "rec_on", "no_confusion", "no_confusion_type", "sizeof", "ibelow", "has_sizeof_inst"]) ∨
d.to_name.has_prefix (λ nm, e.is_ginductive' nm)

/--
Returns true iff `d` is an automatically-generated or internal declaration.
-/
meta def is_auto_or_internal (env : environment) (d : declaration) : bool :=
d.to_name.is_internal || d.is_auto_generated env

/-- Returns the list of universe levels of a declaration. -/
meta def univ_levels (d : declaration) : list level :=
d.univ_params.map level.param

/-- Returns the `reducibility_hints` field of a `defn`, and `reducibility_hints.opaque` otherwise -/
protected meta def reducibility_hints : declaration → reducibility_hints
| (declaration.defn _ _ _ _ red _) := red
| _ := _root_.reducibility_hints.opaque

/-- formats the arguments of a `declaration.thm` -/
private meta def print_thm (nm : name) (tp : expr) (body : task expr) : tactic format :=
do tp ← pp tp, body ← pp body.get,
   return $ "<theorem " ++ to_fmt nm ++ " : " ++ tp ++ " := " ++ body ++ ">"

/-- formats the arguments of a `declaration.defn` -/
private meta def print_defn (nm : name) (tp : expr) (body : expr) (is_trusted : bool) :
  tactic format :=
do tp ← pp tp, body ← pp body,
   return $ "<" ++ (if is_trusted then "def " else "meta def ") ++ to_fmt nm ++ " : " ++ tp ++
     " := " ++ body ++ ">"

/-- formats the arguments of a `declaration.cnst` -/
private meta def print_cnst (nm : name) (tp : expr) (is_trusted : bool) : tactic format :=
do tp ← pp tp,
   return $ "<" ++ (if is_trusted then "constant " else "meta constant ") ++ to_fmt nm ++ " : "
     ++ tp ++ ">"

/-- formats the arguments of a `declaration.ax` -/
private meta def print_ax (nm : name) (tp : expr) : tactic format :=
do tp ← pp tp,
   return $ "<axiom " ++ to_fmt nm ++ " : " ++ tp ++ ">"

/-- pretty-prints a `declaration` object. -/
meta def to_tactic_format : declaration → tactic format
| (declaration.thm nm _ tp bd) := print_thm nm tp bd
| (declaration.defn nm _ tp bd _ is_trusted) := print_defn nm tp bd is_trusted
| (declaration.cnst nm _ tp is_trusted) := print_cnst nm tp is_trusted
| (declaration.ax nm _ tp) := print_ax nm tp

meta instance : has_to_tactic_format declaration :=
⟨to_tactic_format⟩

end declaration

meta instance pexpr.decidable_eq {elab} : decidable_eq (expr elab) :=
unchecked_cast
expr.has_decidable_eq


namespace Lean4Axiomatic

/-! # Handedness -/

/--
Handedness: either left-handed or right-handed.

Intended to be used as a more meaniningful `Bool` type in contexts where it
applies. One example is in selecting the left- or right-hand side of an ordered
pair. Another is in specifying which side of a binary operator an algebraic
property acts on; a common one is the concept of a left inverse (`a⁻¹ * a ≃ 1`)
vs. a right inverse (`a * a⁻¹ ≃ 1`).
-/
inductive Hand where
| /-- Left hand.  -/ L
| /-- Right hand. -/ R

/--
Selects the left-hand or right-hand argument, according to the given `Hand`.

**Named parameters**
- `α`: The `Sort` of the items to select.
-/
abbrev Hand.pick {α : Sort u} : Hand → α → α → α
| L, x, _ => x
| R, _, y => y

end Lean4Axiomatic


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

/- SizeOf -/

class SizeOf (α : Sort u) where
  sizeOf : α → Nat

export SizeOf (sizeOf)

/-
Declare sizeOf instances and theorems for types declared before SizeOf.
From now on, the inductive Compiler will automatically generate sizeOf instances and theorems.
-/

/- Every Type `α` has a default SizeOf instance that just returns 0 for every element of `α` -/
protected def default.sizeOf (α : Sort u) : α → Nat
  | a => 0

instance (priority := low) (α : Sort u) : SizeOf α where
  sizeOf := default.sizeOf α

@[simp] theorem sizeOf_default (n : α) : sizeOf n = 0 := rfl

instance : SizeOf Nat where
  sizeOf n := n

@[simp] theorem sizeOf_nat (n : Nat) : sizeOf n = n := rfl

deriving instance SizeOf for Prod
deriving instance SizeOf for PUnit
deriving instance SizeOf for Bool
deriving instance SizeOf for Option
deriving instance SizeOf for List
deriving instance SizeOf for Array
deriving instance SizeOf for Subtype
deriving instance SizeOf for Fin
deriving instance SizeOf for USize
deriving instance SizeOf for UInt8
deriving instance SizeOf for UInt16
deriving instance SizeOf for UInt32
deriving instance SizeOf for UInt64
deriving instance SizeOf for Char
deriving instance SizeOf for String
deriving instance SizeOf for Substring
deriving instance SizeOf for Except
deriving instance SizeOf for EStateM.Result

/- We manually define `Lean.Name` instance because we use
   an opaque function for computing the hashcode field. -/
protected noncomputable def Lean.Name.sizeOf : Name → Nat
  | anonymous => 1
  | str p s _ => 1 + Name.sizeOf p + sizeOf s
  | num p n _ => 1 + Name.sizeOf p + sizeOf n

noncomputable instance : SizeOf Lean.Name where
  sizeOf n := n.sizeOf

deriving instance SizeOf for Lean.Syntax


example (P Q R : Prop) (HP : P) (HQ : Q) : P :=
begin
  sorry,
end


import .fol .abel

universe u

section weekdays
@[derive has_reflect]
inductive weekday : Type
| monday          : weekday
| another_day     : weekday → weekday

open weekday

meta def dump_weekday (f : weekday) : tactic unit :=
tactic.trace $ to_string (expr.to_raw_fmt (reflect f).to_expr)

-- run_cmd dump_weekday (another_day (another_day monday))
--(app (const weekday.another_day []) (app (const weekday.another_day []) (const weekday.monday [])))

inductive weekday' : Type
| monday          : weekday'
| another_day     : weekday' → weekday'

open weekday'
meta instance has_reflect_weekday' : has_reflect weekday'
| weekday'.monday                  := `(monday)
| (weekday'.another_day x)         := `(λ l, weekday'.another_day l).subst $
                                        by haveI := has_reflect_weekday'; exact (reflect x)

meta def dump_weekday' (f : weekday') : tactic unit :=
tactic.trace $ to_string (expr.to_raw_fmt (reflect f).to_expr)

-- run_cmd dump_weekday' (another_day (another_day monday))
-- (app (const weekday'.another_day []) (app (const weekday'.another_day []) (const weekday'.monday [])))
end weekdays
-- meta instance has_reflect_preterm {L : Language.{u}} : Π{n : ℕ}, has_reflect (preterm L n)
-- | 0 (var k) := `(@preterm.var L).subst (reflect k)

-- @[derive has_reflect]

open fol abel

section preterm_aux
inductive preterm_aux (L : Language.{u}) : Type u
| var     : ℕ → preterm_aux
| func    : ∀ k : ℕ, L.functions k → preterm_aux
| app     : preterm_aux → preterm_aux → preterm_aux

def to_aux {L : Language.{u}} : ∀ {l : ℕ},  preterm L l → preterm_aux L
| 0 (var n)      := preterm_aux.var _ n
| k (func f)     := preterm_aux.func _ f
| k (app t₁ t₂)  := preterm_aux.app (to_aux t₁) (to_aux t₂)

def L_abel_plus' (t₁ t₂ : preterm L_abel 0) : preterm L_abel 0 :=
@term_of_function L_abel 2 (abel_functions.plus : L_abel.functions 2) t₁ t₂
end preterm_aux

local infix ` +' `:100 := L_abel_plus'

local notation ` zero ` := (func abel_functions.zero : preterm L_abel 0)

section L_abel_term_biopsy

def sample1 : preterm L_abel 0 := (zero +' zero)

def sample2 : preterm L_abel 0 := zero

-- #reduce sample2

open expr
meta def sample2_expr : expr :=
mk_app (const `preterm.func list.nil) ([(const `L_abel list.nil), `(0), const `abel_functions.zero list.nil] : list expr)

end L_abel_term_biopsy

section simpler_biopsy

inductive my_inductive : Type
| a : my_inductive
| b : my_inductive
| f : my_inductive → my_inductive

open my_inductive
def sample3 : my_inductive := f a

open expr

meta def sample3_expr : expr :=
app (const `my_inductive.f list.nil) (const `my_inductive.a list.nil)

def sample3_again : my_inductive := by tactic.exact (sample3_expr)

example : sample3 = sample3_again := rfl

end simpler_biopsy

namespace tactic
namespace interactive
open interactive interactive.types expr

def my_test_term : preterm L_abel 0 := (zero +' zero)

end interactive
end tactic

section test
-- def my_term : preterm L_abel 0 := sorry

-- #check tactic.interactive.rcases

end test

section sample4

/-- Note: this is the same as `dfin` -/
inductive my_indexed_family : ℕ → Type u
| z {} : my_indexed_family 0
| s : ∀ {k}, my_indexed_family k → my_indexed_family (k+1)

-- meta example : ∀ {n}, has_reflect (my_indexed_family n)
-- | 0 z := `(z)

open my_indexed_family

def sample4 : my_indexed_family 1 := s z

-- #check tactic.eval_expr

end sample4

section sample4

inductive dfin'' : ℕ → Type
| fz {n} : dfin'' (n+1)
| fs {n} : dfin'' n → dfin'' (n+1)

inductive dfin' : ℕ → Type u
| gz {n} :  dfin' (n+1)
| gs {n} :  dfin' n → dfin' (n+1)

open dfin dfin'

meta instance dfin.reflect : ∀ {n}, has_reflect (dfin'' n)
| _ dfin''.fz := `(dfin''.fz)
| _ (dfin''.fs n) := `(dfin''.fs).subst (dfin.reflect n)

-- /- errors all over---why doesn't reflect like universe parameters? -/
-- meta instance dfin'.reflect : ∀ {n}, has_reflect (dfin' n)
-- | _ fz := `(fz)
-- | _ (fs n) := `(fs).subst (dfin'.reflect n)

end sample4

section reflect_preterm

/- Language with a single constant symbol -/
inductive L_pt_functions : ℕ → Type
| pt : L_pt_functions 0

def L_pt : Language.{0} := ⟨L_pt_functions, λ _, empty⟩

def pt_preterm : preterm L_pt 0 := preterm.func L_pt_functions.pt

meta def pt_preterm_reflected : expr :=
expr.mk_app (expr.const `preterm.func [level.zero]) [ (expr.const `L_pt list.nil), `(0), (expr.const `L_pt_functions.pt list.nil)]

set_option trace.app_builder true

-- meta def pt_preterm_reflected' : expr := by tactic.mk_app "preterm.func" [(expr.const `L_pt []), `(0), (expr.const `L_pt_functions.pt [])]

#check tactic.mk_app

meta def pt_preterm_reflected'' : tactic expr :=
tactic.to_expr ```(preterm.func L_pt_functions.pt : preterm L_pt 0)

def pt_preterm' : preterm L_pt 0 := by pt_preterm_reflected'' >>= tactic.exact

-- def pt_preterm' : preterm L_pt 0 := by tactic.exact pt_preterm_reflected

example : pt_preterm = pt_preterm' := rfl
  -- infer type failed, incorrect number of universe levels

-- want: example : pt_preterm = pt_preterm' := rfl

end reflect_preterm

namespace hewwo
section reflect_preterm2
def L_pt.pt' : L_pt.functions 0 := L_pt_functions.pt

#reduce (by apply_instance : reflected L_pt.pt')
-- `(L_pt.pt')

meta def pt_preterm_reflected : tactic expr :=
tactic.mk_app ``preterm.func [`(L_pt.pt')]

def pt_preterm' : preterm L_pt 0 := by pt_preterm_reflected >>= tactic.exact

#eval tactic.trace (@expr.to_raw_fmt tt `(L_pt.pt'))

#check reflect

end reflect_preterm2
end hewwo

section reflect_preterm3

inductive L_pt_func_functions : ℕ → Type
| pt  : L_pt_func_functions 0
| foo : L_pt_func_functions 1

open L_pt_func_functions

def L_pt_func : Language.{0} :=
⟨L_pt_func_functions, λ _, ulift empty⟩

-- def foo_pt_term : preterm L_pt_func 0 :=
-- preterm.app (preterm.func L_pt_func_functions.foo) (preterm.func L_pt_func_functions.pt)

-- def foo_pt_term_reflected : expr :=
-- begin
--   tactic.mk_app ``preterm.func [(by tactic.mk_app `preterm.func [`(L_pt_func_functions.foo)]), (by tactic.mk_app `preterm.func [`(L_pt_func_functions.pt)])]
-- end

-- def foo' : preterm L_pt_func 1 := preterm.func L_pt_func_functions.foo

-- #reduce (by apply_instance : reflected L_pt_func_functions.foo)

set_option trace.app_builder true

def my_foo : L_pt_func.functions 1 := L_pt_func_functions.foo

def my_pt : L_pt_func.functions 0 := L_pt_func_functions.pt

-- meta def foo_pt_term_reflected : tactic expr := tactic.mk_app ``preterm.func [`()]

meta def foo_pt_term_reflected' : tactic expr :=
do e₁ <- tactic.mk_app ``preterm.func [`(my_foo)],
   e₂ <- tactic.mk_app ``preterm.func [`(my_pt)],
   tactic.mk_app ``preterm.app [e₁, e₂]
-- #print foo_pt_term_reflected'

-- meta def bar : tactic expr :=
--   tactic.mk_app ``preterm.func [`(foo_mask)]

set_option trace.app_builder true

def foo_pt_term_reflected : preterm L_pt_func 0 := by (foo_pt_term_reflected' >>= tactic.exact)

-- #reduce foo_pt_term_reflected

end reflect_preterm3


example : n.succ = 1 → n = 0 := by
  intros h; injection h; assumption

example (h : n.succ = 1) : n = 0 := by
  injection h; assumption

constant T : Type
constant T.Pred : T → T → Prop

example {ρ} (hρ : ρ.Pred σ) : T.Pred ρ ρ := sorry


structure A where
  x : Nat
  w : Nat

structure B extends A where
  y : Nat

structure C extends B where
  z : Nat

def f1 (c : C) (a : A) : C :=
  { c with toA := a, x := 0 }  -- Error, `toA` and `x` are both updates to field `x`

def f2 (c : C) (a : A) : C :=
  { c with toA := a }

def f3 (c : C) (a : A) : C :=
  { a, c with x := 0 }

theorem ex1 (a : A) (c : C) : (f3 c a).x = 0 :=
  rfl

theorem ex2 (a : A) (c : C) : (f3 c a).w = a.w :=
  rfl

def f4 (c : C) (a : A) : C :=
  { c, a with x := 0 } -- TODO: generate error that `a` was not used?

theorem ex3 (a : A) (c : C) : (f4 c a).w = c.w :=
  rfl

theorem ex4 (a : A) (c : C) : (f4 c a).x = 0 :=
  rfl

def f5 (c : C) (a : A) :=
  { c, a with x := 0 } -- Error