import Lean

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

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

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

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

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

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

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

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

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

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

#check mynota 1
     --^ textDocument/hover

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

#check mynota 1
     --^ textDocument/hover

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

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

#check mynota' 1
     --^ textDocument/hover

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

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

@[inherit_doc] notation "ℕ" => Nat

#check ℕ
     --^ textDocument/hover

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

mycmd 1
--^ textDocument/hover

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

mycmd 1
--^ textDocument/hover

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

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

mycmd' 1
--^ textDocument/hover

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

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

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

opaque foo : Nat

#check _root_.foo
       --^ textDocument/hover

namespace Bar

opaque foo : Nat
     --^ textDocument/hover

#check _root_.foo
       --^ textDocument/hover

def bar := 1
  --^ textDocument/hover

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


import tactic.interactive

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

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

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

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


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

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


import data.pfun

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

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

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

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

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

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

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

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

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

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

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

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

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

end pfun


import Lean

import Meta.Boolean
import Meta.Pull

open Lean Elab.Tactic Meta

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

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

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

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

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

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

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

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


import «smt-lean»

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


import ..lectures.love05_inductive_predicates_demo

/-! # LoVe Demo 7: Metaprogramming

Note for Brown FPV students: we are not following this demo directly!
But I'm posting it because some definitions in here are used in the exercises.
 --Rob

Users can extend Lean with custom tactics and tools. This kind of
programming—programming the prover—is called metaprogramming.

Lean's metaprogramming framework uses mostly the same notions and syntax as
Lean's input language itself. Abstract syntax trees __reflect__ internal data
structures, e.g., for expressions (terms). The prover's C++ internals are
exposed through Lean interfaces, which we can use for

* accessing the current context and goal;
* unifying expressions;
* querying and modifying the environment;
* setting attributes.

Most of Lean's predefined tactics are implemented in Lean (and not in C++).

Example applications:

* proof goal transformations;
* heuristic proof search;
* decision procedures;
* definition generators;
* advisor tools;
* exporters;
* ad hoc automation.

Advantages of Lean's metaprogramming framework:

* Users do not need to learn another programming language to write
  metaprograms; they can work with the same constructs and notation used to
  define ordinary objects in the prover's library.

* Everything in that library is available for metaprogramming purposes.

* Metaprograms can be written and debugged in the same interactive environment,
  encouraging a style where formal libraries and supporting automation are
  developed at the same time. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Tactics and Tactic Combinators

When programming our own tactics, we often need to repeat some actions on
several goals, or to recover if a tactic fails. Tactic combinators help in such
case.

`repeat` applies its argument repeatedly on all (sub…sub)goals until it cannot
be applied any further. -/

lemma repeat_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  repeat { apply even.add_two },
  repeat { sorry }
end

/-! The "orelse" combinator `<|>` tries its first argument and applies its
second argument in case of failure. -/

lemma repeat_orelse_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  repeat {
    apply even.add_two
    <|> apply even.zero },
  repeat { sorry }
end

/-! `iterate` works repeatedly on the first goal until it fails; then it
stops. -/

lemma iterate_orelse_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  iterate {
    apply even.add_two
    <|> apply even.zero },
  repeat { sorry }
end

/-! `all_goals` applies its argument exactly once to each goal. It succeeds only
if the argument succeeds on **all** goals. -/

lemma all_goals_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  all_goals { apply even.add_two },   -- fails
  repeat { sorry }
end

/-! `try` transforms its argument into a tactic that never fails. -/

lemma all_goals_try_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  all_goals { try { apply even.add_two } },
  repeat { sorry }
end

/-! `any_goals` applies its argument exactly once to each goal. It succeeds
if the argument succeeds on **any** goal. -/

lemma any_goals_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  any_goals { apply even.add_two },
  repeat { sorry }
end

/-! `solve1` transforms its argument into an all-or-nothing tactic. If the
argument does not prove the goal, `solve1` fails. -/

lemma any_goals_solve1_repeat_orelse_example :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  repeat { apply and.intro },
  any_goals { solve1 { repeat {
    apply even.add_two
    <|> apply even.zero } } },
  repeat { sorry }
end

/-! The combinators `repeat`, `iterate`, `all_goals`, and `any_goals` can easily
lead to infinite looping: -/

/-
lemma repeat_not_example :
  ¬ even 1 :=
begin
  repeat { apply not.intro },
  sorry
end
-/

/-! Let us start with the actual metaprogramming, by coding a custom tactic. The
tactic embodies the behavior we hardcoded in the `solve1` example above: -/

meta def intro_and_even : tactic unit :=
do
  tactic.repeat (tactic.applyc ``and.intro),
  tactic.any_goals (tactic.solve1 (tactic.repeat
    (tactic.applyc ``even.add_two
     <|> tactic.applyc ``even.zero))),
  pure ()

/-! The `meta` keyword makes it possible for the function to call other
metafunctions. The `do` keyword enters a monad, and the `<|>` operator is the
"orelse" operator of alternative monads. At the end, we return `()`, of type
`unit`, to ensure the metaprogram has the desired type.

Any executable Lean definition can be used as a metaprogram. In addition, we can
put `meta` in front of a definition to indicate that is a metadefinition. Such
definitions need not terminate but cannot be used in non-`meta` contexts.

Let us apply our custom tactic: -/

lemma any_goals_solve1_repeat_orelse_example₂ :
  even 4 ∧ even 7 ∧ even 3 ∧ even 0 :=
begin
  intro_and_even,
  repeat { sorry }
end

/-! ## The Metaprogramming Monad

Tactics have access to

* the list of **goals** as metavariables (each metavariables has a type and a
  local context (hypothesis); they can optionally be instantiated);

* the **elaborator** (to elaborate expressions and compute their type);

* the **environment**, containing all declarations and inductive types;

* the **attributes** (e.g., the list of `@[simp]` rules).

The tactic monad is an alternative monad, with `fail` and `<|>`. Tactics can
also produce trace messages. -/

lemma even_14 :
  even 14 :=
by do
  tactic.trace "Proving evenness …",
  intro_and_even

meta def hello_then_intro_and_even : tactic unit :=
do
  tactic.trace "Proving evenness …",
  intro_and_even

lemma even_16 :
  even 16 :=
by hello_then_intro_and_even

run_cmd tactic.trace "Hello, Metaworld!"

meta def trace_goals : tactic unit :=
do
  tactic.trace "local context:",
  ctx ← tactic.local_context,
  tactic.trace ctx,
  tactic.trace "target:",
  P ← tactic.target,
  tactic.trace P,
  tactic.trace "all missing proofs:",
  Hs ← tactic.get_goals,
  tactic.trace Hs,
  τs ← list.mmap tactic.infer_type Hs,
  tactic.trace τs

lemma even_18_and_even_20 (α : Type) (a : α) :
  even 18 ∧ even 20 :=
by do
  tactic.applyc ``and.intro,
  trace_goals,
  intro_and_even

lemma triv_imp (a : Prop) (h : a) :
  a :=
by do
  h ← tactic.get_local `h,
  tactic.trace "h:",
  tactic.trace h,
  tactic.trace "raw h:",
  tactic.trace (expr.to_raw_fmt h),
  tactic.trace "type of h:",
  τ ← tactic.infer_type h,
  tactic.trace τ,
  tactic.trace "type of type of h:",
  υ ← tactic.infer_type τ,
  tactic.trace υ,
  tactic.apply h

meta def exact_list : list expr → tactic unit
| []        := tactic.fail "no matching expression found"
| (h :: hs) :=
  do {
    tactic.trace "trying",
    tactic.trace h,
    tactic.exact h }
  <|> exact_list hs

meta def hypothesis : tactic unit :=
do
  hs ← tactic.local_context,
  exact_list hs

lemma app_of_app {α : Type} {p : α → Prop} {a : α}
    (h : p a) :
  p a :=
by hypothesis

/-! ## Names, Expressions, Declarations, and Environments

The metaprogramming framework is articulated around five main types:

* `tactic` manages the proof state, the global context, and more;

* `name` represents a structured name (e.g., `x`, `even.add_two`);

* `expr` represents an expression (a term) as an abstract syntax tree;

* `declaration` represents a constant declaration, a definition, an axiom, or a
  lemma;

* `environment` stores all the declarations and notations that make up the
  global context. -/

#print expr

#check expr tt  -- elaborated expressions
#check expr ff  -- unelaborated expressions (pre-expressions)

#print name

#check (expr.const `ℕ [] : expr)
#check expr.sort level.zero  -- Sort 0, i.e., Prop
#check expr.sort (level.succ level.zero)
  -- Sort 1, i.e., Type
#check expr.var 0  -- bound variable with De Bruijn index 0
#check (expr.local_const `uniq_name `pp_name binder_info.default
  `(ℕ) : expr)
#check (expr.mvar `uniq_name `pp_name `(ℕ) : expr)
#check (expr.pi `pp_name binder_info.default `(ℕ)
  (expr.sort level.zero) : expr)
#check (expr.lam `pp_name binder_info.default `(ℕ)
  (expr.var 0) : expr)
#check expr.elet
#check expr.macro

/-! We can create literal expressions conveniently using backticks and
parentheses:

* Expressions with a single backtick must be fully elaborated.

* Expressions with two backticks are __pre-expressions__: They may contain some
  holes to be filled in later, based on some context.

* Expressions with three backticks are pre-expressions without name checking. -/

run_cmd do
  let e : expr := `(list.map (λn : ℕ, n + 1) [1, 2, 3]),
  tactic.trace e

run_cmd do
  let e : expr := `(list.map _ [1, 2, 3]),   -- fails
  tactic.trace e

run_cmd do
  let e₁ : pexpr := ``(list.map (λn, n + 1) [1, 2, 3]),
  let e₂ : pexpr := ``(list.map _ [1, 2, 3]),
  tactic.trace e₁,
  tactic.trace e₂

run_cmd do
  let e : pexpr := ```(seattle.washington),
  tactic.trace e

/-! We can also create literal names with backticks:

* Names with a single backtick, `n, are not checked for existence.

* Names with two backticks, ``n, are resolved and checked. -/

run_cmd tactic.trace `and.intro
run_cmd tactic.trace `intro_and_even
run_cmd tactic.trace `seattle.washington

run_cmd tactic.trace ``and.intro
run_cmd tactic.trace ``intro_and_even
run_cmd tactic.trace ``seattle.washington   -- fails

/-! __Antiquotations__ embed an existing expression in a larger expression. They
are announced by the prefix `%%` followed by a name from the current context.
Antiquotations are available with one, two, and three backticks: -/

run_cmd do
  let x : expr := `(2 : ℕ),
  let e : expr := `(%%x + 1),
  tactic.trace e

run_cmd do
  let x : expr  := `(@id ℕ),
  let e : pexpr := ``(list.map %%x),
  tactic.trace e

run_cmd do
  let x : expr  := `(@id ℕ),
  let e : pexpr := ```(a _ %%x),
  tactic.trace e

lemma one_add_two_eq_three :
  1 + 2 = 3 :=
by do
  `(%%a + %%b = %%c) ← tactic.target,
  tactic.trace a,
  tactic.trace b,
  tactic.trace c,
  `(@eq %%α %%l %%r) ← tactic.target,
  tactic.trace α,
  tactic.trace l,
  tactic.trace r,
  tactic.exact `(refl _ : 3 = 3)

#print declaration

/-! The `environment` type is presented as an abstract type, equipped with some
operations to query and modify it. The `environment.fold` metafunction iterates
over all declarations making up the environment. -/

run_cmd do
  env ← tactic.get_env,
  tactic.trace (environment.fold env 0 (λdecl n, n + 1))

/-! ## First Example: A Conjuction-Destructing Tactic

We define a `destruct_and` tactic that automates the elimination of `∧` in
premises, automating proofs such as these: -/

lemma abcd_a (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  a :=
and.elim_left h

lemma abcd_b (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b :=
and.elim_left (and.elim_left (and.elim_right h))

lemma abcd_bc (a b c d : Prop) (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ c :=
and.elim_left (and.elim_right h)

/-! Our tactic relies on a helper metafunction, which takes as argument the
hypothesis `h` to use as an expression rather than as a name: -/

meta def destruct_and_helper : expr → tactic unit
| h :=
  do
    t ← tactic.infer_type h,
    match t with
    | `(%%a ∧ %%b) :=
      tactic.exact h
      <|>
      do {
        ha ← tactic.to_expr ``(and.elim_left %%h),
        destruct_and_helper ha }
      <|>
      do {
        hb ← tactic.to_expr ``(and.elim_right %%h),
        destruct_and_helper hb }
    | _            := tactic.exact h
    end

meta def destruct_and (nam : name) : tactic unit :=
do
  h ← tactic.get_local nam,
  destruct_and_helper h

/-! Let us check that our tactic works: -/

lemma abc_a (a b c : Prop) (h : a ∧ b ∧ c) :
  a :=
by destruct_and `h

lemma abc_b (a b c : Prop) (h : a ∧ b ∧ c) :
  b :=
by destruct_and `h

lemma abc_bc (a b c : Prop) (h : a ∧ b ∧ c) :
  b ∧ c :=
by destruct_and `h

lemma abc_ac (a b c : Prop) (h : a ∧ b ∧ c) :
  a ∧ c :=
by destruct_and `h   -- fails

/-! ## Second Example: A Provability Advisor

Next, we implement a `prove_direct` tool that traverses all lemmas in the
database and checks whether one of them can be used to prove the current goal. A
similar tactic is available in `mathlib` under the name `library_search`. -/

meta def is_theorem : declaration → bool
| (declaration.defn _ _ _ _ _ _) := ff
| (declaration.thm _ _ _ _)      := tt
| (declaration.cnst _ _ _ _)     := ff
| (declaration.ax _ _ _)         := tt

meta def get_all_theorems : tactic (list name) :=
do
  env ← tactic.get_env,
  pure (environment.fold env [] (λdecl nams,
    if is_theorem decl then declaration.to_name decl :: nams
    else nams))

meta def prove_with_name (nam : name) : tactic unit :=
do
  tactic.applyc nam
    ({ md := tactic.transparency.reducible, unify := ff }
     : tactic.apply_cfg),
  tactic.all_goals tactic.assumption,
  pure ()

meta def prove_direct : tactic unit :=
do
  nams ← get_all_theorems,
  list.mfirst (λnam,
      do
        prove_with_name nam,
        tactic.trace ("directly proved by " ++ to_string nam))
    nams

lemma nat.eq_symm (x y : ℕ) (h : x = y) :
  y = x :=
by prove_direct

lemma nat.eq_symm₂ (x y : ℕ) (h : x = y) :
  y = x :=
by library_search

lemma list.reverse_twice (xs : list ℕ) :
  list.reverse (list.reverse xs) = xs :=
by prove_direct

lemma list.reverse_twice_symm (xs : list ℕ) :
  xs = list.reverse (list.reverse xs) :=
by prove_direct   -- fails

/-! As a small refinement, we propose a version of `prove_direct` that also
looks for equalities stated in symmetric form. -/

meta def prove_direct_symm : tactic unit :=
prove_direct
<|>
do {
  tactic.applyc `eq.symm,
  prove_direct }

lemma list.reverse_twice₂ (xs : list ℕ) :
  list.reverse (list.reverse xs) = xs :=
by prove_direct_symm

lemma list.reverse_twice_symm₂ (xs : list ℕ) :
  xs = list.reverse (list.reverse xs) :=
by prove_direct_symm

/-! ## A Look at Two Predefined Tactics

Quite a few of Lean's predefined tactics are implemented as metaprograms and
not in C++. We can find these definitions by clicking the name of a construct
in Visual Studio Code while holding the control or command key. -/

#check tactic.intro
#check tactic.assumption

end LoVe


/-
Copyright (c) 2023 Thomas Murrills. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Murrills
-/
import Lean

/-!
# Fail if no progress

This implements the `fail_if_no_progress` tactic, which fails if no actual progress is made by the
following tactic sequence.

"Actual progress" means that either the number of goals has changed, that the
number or presence of expressions in the context has changed, or that the type of some expression
in the context or the type of the goal is no longer definitionally equal to what it used to be at
reducible transparency.

This means that, for example, `1 - 1` changing to `0` does not count as actual progress, since
```lean
example : (1 - 1 = 0) := by with_reducible rfl
```

This tactic is useful in situations where we want to stop iterating some tactics if they're not
having any  effect, e.g. `repeat (fail_if_no_progress simp <;> ring_nf)`.

-/

namespace Mathlib.Tactic

open Lean Meta Elab Tactic

/-- `fail_if_no_progress tacs` evaluates `tacs`, and fails if no progress is made on the main goal
or the local context at reducible transparency. -/
syntax (name := failIfNoProgress ) "fail_if_no_progress " tacticSeq : tactic

/-- `lctxIsDefEq l₁ l₂` compares two lists of `Option LocalDecl`s (as returned from e.g.
`(← (← getMainGoal).getDecl).lctx.decls.toList`). It returns `true` if they contain expressions of
the same type in the same order (up to defeq), and `false` otherwise. -/
def lctxIsDefEq : (l₁ l₂ : List (Option LocalDecl)) → MetaM Bool
  | some d₁ :: l₁, some d₂ :: l₂ => do
    unless (← withNewMCtxDepth <| isDefEq d₁.type d₂.type) do
      return false
    lctxIsDefEq l₁ l₂
  | none :: l₁, none :: l₂ => lctxIsDefEq l₁ l₂
  | [], [] => return true
  | _, _ => return false

/-- Run `tacs : TacticM Unit` on `goal`, and fail if no progress is made. -/
def runAndFailIfNoProgress (goal : MVarId) (tacs : TacticM Unit) : TacticM (List MVarId) := do
  let l ← run goal tacs
  try
    let [newGoal] := l | failure
    guard <|← withNewMCtxDepth <| withReducible <| isDefEq (← newGoal.getType) (← goal.getType)
    let ctxDecls := (← goal.getDecl).lctx.decls.toList
    let newCtxDecls := (← newGoal.getDecl).lctx.decls.toList
    guard <|← withNewMCtxDepth <| withReducible <| lctxIsDefEq ctxDecls newCtxDecls
  catch _ =>
    return l
  throwError "no progress made on {goal}"

elab_rules : tactic
| `(tactic| fail_if_no_progress $tacs) => do
  let goal ← getMainGoal
  let l ← runAndFailIfNoProgress goal (evalTactic tacs)
  replaceMainGoal l


example [Subsingleton α] (p : α → Prop) : Subsingleton (Subtype p) :=
  ⟨fun ⟨x, _⟩ ⟨y, _⟩ => Subsingleton.elim x y ▸ sorry⟩


import .def_coords

universe u

namespace o_minimal

open_locale finvec

variables {R : Type u} (S : struc R)

-- We set up a minimal theory of (literal) definable subsets of Rⁿ
-- and definable functions between them.

/-- A bundled definable subset of some Rⁿ. -/
structure Def : Type u :=
(ambdim : ℕ)
(to_set : set (finvec ambdim R))
(is_definable : S.definable to_set)

variables {S}

instance : has_coe_to_sort (Def S) :=
⟨Type u, λ X, X.to_set⟩

lemma Def.is_def_coords (X : Def S) : S.def_coords (set.univ : set X) :=
begin
  unfold struc.def_coords,
  convert X.is_definable,
  simp
end

variables (S)

def struc.definable_fun {X Y : Def S} (f : X → Y) : Prop :=
S.def_coords {z : X × Y | f z.1 = z.2}

variables {S}

@[ext] structure Hom (X Y : Def S) : Type u :=
(to_fun : X → Y)
(is_definable : S.definable_fun to_fun)

instance {X Y : Def S} : has_coe_to_fun (Hom X Y) :=
⟨_, λ f, f.to_fun⟩

--instance : category_theory.has_hom (Def S) := { hom := Hom }
local infixr ` ⟶ `:10 := Hom

@[simp] lemma Hom.to_fun_eq_coe {X Y : Def S} (f : X ⟶ Y) :
  f.to_fun = f :=
rfl

-- TODO float out proofs of definability of identity, composition
-- (useful later in presheaf stuff, notably representable instance)

def Def.id (X : Def S) : X ⟶ X :=
{ to_fun := id,
  is_definable := struc.def_coords.diag X.is_def_coords }

def Hom.comp {X Y Z : Def S} (g : Y ⟶ Z) (f : X ⟶ Y) : X ⟶ Z :=
{ to_fun := g.to_fun ∘ f.to_fun,
  is_definable := begin
    suffices : S.def_coords {p : X × Z | ∃ y, f p.1 = y ∧ g y = p.2},
    { convert this,
      ext ⟨x, z⟩,
      simp [struc.definable_fun] },
    have dXZY : S.def_coords (set.univ : set ((X × Z) × Y)) :=
      (X.is_def_coords.prod_univ Z.is_def_coords).prod_univ Y.is_def_coords,
    apply struc.def_coords.exists,
    apply struc.def_coords.inter,
    { let φ : (X × Z) × Y → X × Y := λ p, (p.1.1, p.2),
      have : is_reindexing R φ :=
        is_reindexing.prod R ((is_reindexing.fst R).comp R (is_reindexing.fst R)) (is_reindexing.snd R),
      refine struc.def_coords.reindex dXZY this f.is_definable },
    { let φ : (X × Z) × Y → Y × Z := λ p, (p.2, p.1.2),
      have : is_reindexing R φ :=
        is_reindexing.prod R (is_reindexing.snd R) ((is_reindexing.snd R).comp R (is_reindexing.fst R)),
      refine struc.def_coords.reindex dXZY this g.is_definable },
  end }

lemma Hom.comp_id {X Y : Def S} (f : X ⟶ Y) : f.comp (Def.id X) = f :=
by { ext, refl }

lemma Hom.id_comp {X Y : Def S} (f : X ⟶ Y) : (Def.id Y).comp f = f :=
by { ext, refl }

lemma Hom.comp_assoc {W X Y Z : Def S} (h : Y ⟶ Z) (g : X ⟶ Y) (f : W ⟶ X) :
  (h.comp g).comp f = h.comp (g.comp f) :=
rfl

def pt : Def S :=
{ ambdim := 0,
  to_set := set.univ,
  is_definable := S.definable_univ 0 }

instance pt.unique : unique (pt : Def S) :=
⟨⟨⟨fin_zero_elim, trivial⟩⟩, λ x, by { ext i, fin_cases i }⟩

/-! ### Presheaf stuff -/

variables (S)

-- TODO: generalize to Sort?
class definable_psh (X : Type*) :=
(definable : Π {K : Def S}, (K → X) → Prop)
(definable_precomp : ∀ {L K : Def S} (φ : L ⟶ K) {f : K → X},
  definable f → definable (f ∘ φ))

-- TODO: apply bug??
def definable {X : Type*} [definable_psh S X] (x : X) : Prop :=
definable_psh.definable (λ (_ : (pt : Def S)), x)

variables {S}

def definable_psh.definable' {X : Type*} (h : definable_psh S X) {K : Def S} (f : K → X) : Prop :=
definable_psh.definable f

instance Def.definable_psh (X : Def S) : definable_psh S X :=
{ definable := λ K f, S.definable_fun f,
  definable_precomp := begin
    rintros L K φ f h,
    exact ((⟨f, h⟩ : K ⟶ X).comp φ).is_definable
  end }

lemma pt.definable {K : Def S} {f : K → (pt : Def S)} : definable_psh.definable f :=
begin
  change S.definable _,
  convert K.is_def_coords using 1,
  ext x,
  split,
  { rintros ⟨⟨k, p⟩, -, rfl⟩,
    refine ⟨k, trivial, _⟩,
    simp },
  { rintros ⟨k, -, rfl⟩,
    refine ⟨⟨k, default _⟩, show _ = _, by cc, _⟩,
    simp }
end

instance {X Y : Type*} [definable_psh S X] [definable_psh S Y] : definable_psh S (X × Y) :=
{ definable := λ K f, definable_psh.definable (prod.fst ∘ f) ∧ definable_psh.definable (prod.snd ∘ f),
  definable_precomp := begin
    rintros L K φ _ ⟨h₁, h₂⟩,
    exact ⟨definable_psh.definable_precomp φ h₁, definable_psh.definable_precomp φ h₂⟩,
  end }

instance function.definable_psh {X Y : Type*} [hX : definable_psh S X] [hY : definable_psh S Y] :
  definable_psh S (X → Y) :=
{ definable := λ K f, ∀ (M : Def S) {g : M → K × X} (h : definable_psh.definable g),
    definable_psh.definable (function.uncurry f ∘ g),
  definable_precomp := λ L K φ f hf M g hg, begin
    suffices : definable_psh.definable (λ m, (φ (g m).1, (g m).2)),
    { apply hf M this },
    split,
    { exact definable_psh.definable_precomp ⟨λ m, (g m).1, hg.1⟩
        (show definable_psh.definable φ, from φ.is_definable) },
    { exact hg.2 }
  end }

lemma definable_fun {X Y : Type*} [definable_psh S X] [definable_psh S Y]
  {f : X → Y} : definable S f ↔
  ∀ {K : Def S} (φ : K → X), definable_psh.definable φ → definable_psh.definable (f ∘ φ) :=
begin
  split; intro H,
  { intros K φ hφ,
    -- TODO: This proof is awkward
    specialize H K,
    swap,
    { exact (λ k, (default _, φ k)) },
    exact H ⟨pt.definable, hφ⟩ },
  { intros K φ hφ,
    exact H _ hφ.2 }
end

lemma definable_app {X Y : Type*} [definable_psh S X] [definable_psh S Y]
  {f : X → Y} (hf : definable S f) {x : X} (hx : definable S x) : definable S (f x) :=
begin
  rw definable_fun at hf,
  exact hf _ hx
end

lemma definable.app_ctx {Γ X Y : Type*} [definable_psh S Γ] [definable_psh S X] [definable_psh S Y]
  {f : Γ → X → Y} (hf : definable S f) {x : Γ → X} (hx : definable S x) :
  definable S (λ γ, f γ (x γ)) :=
begin
  rw definable_fun at ⊢ hf hx,
  intros K φ hφ,
  change definable_psh.definable (λ k, f (φ k) (x (φ k))),
  specialize hf φ hφ,
  specialize hf K,
  swap, { exact λ k, (k, x (φ k)) },
  exact hf ⟨(Def.id K).is_definable, hx φ hφ⟩
end

lemma definable_yoneda {K : Def S} {X : Type*} [definable_psh S X]
  {f : K → X} : definable_psh.definable f ↔ definable S f :=
begin
  rw definable_fun,
  split,
  { intros h L φ hφ,
    exact definable_psh.definable_precomp ⟨φ, hφ⟩ h },
  { intros H,
    refine H id _,
    exact (Def.id K).is_definable }
end

lemma definable_prod_mk {X Y : Type*} [definable_psh S X] [definable_psh S Y] :
  definable S (prod.mk : X → Y → X × Y) :=
-- I have no idea how to come up with these proofs.
-- Maybe we should tweak the type of definable_precomp (or write a lemma)
-- that takes the underlying map φ and its proof of definability separately
-- so that Lean has a better chance of guessing what's happening?
λ L g h L' g' h',
⟨definable_psh.definable_precomp ⟨λ x, (g' x).fst, h'.1⟩ h.2, h'.2⟩

lemma definable_fst {X Y : Type*} [definable_psh S X] [definable_psh S Y] :
  definable S (prod.fst : X × Y → X) :=
begin
  rw definable_fun,
  intros K φ hφ,
  exact hφ.1
end

lemma definable_snd {X Y : Type*} [definable_psh S X] [definable_psh S Y] :
  definable S (prod.snd : X × Y → Y) :=
begin
  rw definable_fun,
  intros K φ hφ,
  exact hφ.2
end

lemma definable.prod_mk {W X Y : Type*} [definable_psh S W] [definable_psh S X] [definable_psh S Y]
  {f : W → X} (hf : definable S f) {g : W → Y} (hg : definable S g) :
  definable S (λ w, (f w, g w)) :=
begin
  rw definable_fun at ⊢ hf hg,
  intros K φ hφ,
  exact ⟨hf φ hφ, hg φ hφ⟩
end

lemma definable_fun₂ {X Y Z : Type*} [definable_psh S X] [definable_psh S Y] [definable_psh S Z]
  {f : X → Y → Z} :
  (∀ {L : Def S} (φ : L → X), definable S φ → definable S (f ∘ φ)) ↔
  (∀ {L : Def S} (φ : L → X × Y), definable S φ → definable S (function.uncurry f ∘ φ)) :=
begin
  split; intro H,
  { intros L φ hφ,
    rw definable_fun at ⊢,
    intros K ψ hψ,
    have : definable S (prod.fst ∘ φ),
    { rw ←definable_yoneda at ⊢ hφ,
      exact hφ.1 },
    specialize H (λ l, (φ l).1) this,
    rw definable_fun at H,
    specialize H ψ hψ,
    specialize H K,
    swap, { exact λ k, (k, (φ (ψ k)).2) },
    refine H ⟨(Def.id K).is_definable, _⟩, clear H,
    rw ←definable_yoneda at hφ,
    exact definable_psh.definable_precomp ⟨ψ, hψ⟩ hφ.2 },
  { intros L φ hφ,
    rw definable_fun,
    intros K ψ hψ,
    intros K' ψ' hψ',
    dsimp [function.uncurry, function.comp],
    specialize H (λ k', (φ (ψ (ψ' k').1), (ψ' k').2)),
    have : definable S (λ k', (φ (ψ (ψ' k').1), (ψ' k').2)),
    { rw ←definable_yoneda at ⊢ hφ,
      split,
      { refine definable_psh.definable_precomp ⟨λ k', ψ (ψ' k').fst, _⟩ hφ,
        exact (Hom.comp ⟨ψ, hψ⟩ ⟨_, hψ'.1⟩).is_definable },
      { exact hψ'.2 } },
    specialize H this,
    rw definable_fun at H,
    exact H _ (Def.id _).is_definable }
end

lemma definable_comp {X Y Z : Type*} [definable_psh S X] [definable_psh S Y] [definable_psh S Z] :
  definable S (function.comp : (Y → Z) → (X → Y) → (X → Z)) :=
begin
  -- TODO: Make these 4 lines a lemma.
  rw definable_fun,
  intros L₁ φ₁ hφ₁,
  rw definable_yoneda at ⊢ hφ₁,
  revert L₁,
  -- end lemma
  rw definable_fun₂,
  rw definable_fun₂,
  rintros L φ hφ,
  rw ←definable_yoneda at hφ,
  obtain ⟨⟨hφ₁, hφ₂⟩, hφ₃⟩ := hφ,
  rw definable_yoneda at hφ₁ hφ₂ hφ₃,
  dsimp [function.uncurry, function.comp],
  exact hφ₁.app_ctx (hφ₂.app_ctx hφ₃)
end

lemma definable.comp {X Y Z : Type*} [definable_psh S X] [definable_psh S Y] [definable_psh S Z]
  {g : Y → Z} (hg : definable S g) {f : X → Y} (hf : definable S f) :
  definable S (g ∘ f) :=
definable_app (definable_app definable_comp hg) hf

lemma definable.comp_ctx {Γ X Y Z : Type*} [definable_psh S Γ] [definable_psh S X] [definable_psh S Y] [definable_psh S Z]
  {g : Γ → Y → Z} (hg : definable S g) {f : Γ → X → Y} (hf : definable S f) :
  definable S (λ γ, g γ ∘ f γ) :=
definable.app_ctx (definable.comp definable_comp hg) hf

lemma definable_curry {X Y Z : Type*} [definable_psh S X] [definable_psh S Y] [definable_psh S Z] :
  definable S (function.curry : (X × Y → Z) → X → Y → Z) :=
begin
  -- TODO: Make these 4 lines a lemma.
  rw definable_fun,
  intros L₁ φ₁ hφ₁,
  rw definable_yoneda at ⊢ hφ₁,
  revert L₁,
  -- end lemma
  rw definable_fun₂,
  rw definable_fun₂,
  rintros L φ hφ,
  rw ←definable_yoneda at hφ,
  obtain ⟨⟨hφ₁, hφ₂⟩, hφ₃⟩ := hφ,
  rw definable_yoneda at hφ₁ hφ₂ hφ₃,
  exact definable.app_ctx hφ₁ (hφ₂.prod_mk hφ₃)
end

instance Prop.definable_psh : definable_psh S Prop :=
{ definable := λ K s, S.def_coords s,
  definable_precomp := λ L K φ f hf, sorry } -- preimage

instance set.definable_psh {X : Type*} [definable_psh S X] : definable_psh S (set X) :=
show definable_psh S (X → Prop), by apply_instance

lemma definable_and : definable S (∧) :=
begin
  suffices : definable S (λ r : Prop × Prop, r.1 ∧ r.2),
  { exact definable_app definable_curry this },
  rw definable_fun,
  rintros K φ ⟨hφ₁, hφ₂⟩,
  exact hφ₁.inter hφ₂
end

lemma definable.and {W : Type*} [definable_psh S W]
  {f : W → Prop} (hf : definable S f) {g : W → Prop} (hg : definable S g) :
  definable S (λ w, f w ∧ g w) :=
definable.app_ctx (definable.comp definable_and hf) hg

lemma definable_inter {X : Type*} [definable_psh S X] :
  definable S ((∩) : set X → set X → set X) :=
begin
  suffices : definable S (λ (r : set X × set X) (x : X), r.1 x ∧ r.2 x),
  { exact (definable_app definable_curry this : _) },
  -- TODO: Make these 4 lines a lemma.
  rw definable_fun,
  intros L₁ φ₁ hφ₁,
  rw definable_yoneda at ⊢ hφ₁,
  revert L₁,
  -- end lemma
  rw definable_fun₂,
  intros L φ hφ,
  rw ←definable_yoneda at hφ,
  obtain ⟨⟨hφ₁, hφ₂⟩, hφ₃⟩ := hφ,
  rw definable_yoneda at hφ₁ hφ₂ hφ₃,
  apply definable.and,
  { exact hφ₁.app_ctx hφ₃ },
  { exact hφ₂.app_ctx hφ₃ }
end

/-
instance foo {X Y : Type*} [definable_psh S X] [definable_psh S Y]
  {p : X → Prop}
  : definable_psh S (Π (x : X) (h : p x), Y) :=
sorry
-/

lemma definable_definable {X : Type*} [definable_psh S X] :
  definable S (definable S : X → Prop) :=
begin
  rw definable_fun,
  intros K φ hφ,
  change S.def_coords _,
  convert K.is_def_coords,
  apply set.eq_univ_of_forall,
  intro x,
  change definable S (φ x),
  apply definable_app,
  { rw ←definable_yoneda, exact hφ },
  -- now we need to know that every point of a representable guy
  -- is definable. this needs definable constants!
  sorry
  -- In general, the definable elements of a structure
  -- might or might not form a definable set.
  -- Counterexample: take (ℝ, +, *) without constants;
  -- definable elements are the algebraic real numbers,
  -- but only tame sets can be definable.
  -- However, once the structure has definable constants,
  -- then everything is definable and of course the set `univ` is definable.
end
-- Important note: it is definitely *not* true that
-- `definable S` = `set.univ` on *every* X with a definable_psh structure;
-- just represented guys.

/-
similarly, in an o-minimal structure:

lemma definable_finite [DUNLO R] [o_minimal S] :
  definable S (set.finite : set R → Prop) := sorry

because "finite" is equivalent to "does not contain an interval"
on the tame = definable sets, which are the only ones that matter.
-/

instance self : definable_psh S R := sorry

variables (S)

#exit
class definable_fam {X : Type*} [definable_psh S X] (Y : X → Sort*) :=
(definable : Π {K : Def S} (x : K → X) (hx : definable_psh.definable x), (Π k, Y (x k)) → Prop)
-- s.t. blah blah blah...

instance moo {X : Type*} {Y : X → Type*} [definable_psh S X] [definable_fam S Y] :
  definable_psh S (Π (x : X), Y x) :=
sorry

constant choice : Π (X : set R), X.nonempty → X

example : definable S (set.nonempty : set R → Prop) :=
sorry

instance : definable_fam S (set.nonempty : set R → Prop) := sorry

instance pi {X : Type*} [definable_psh S X] {Y Z : X → Sort*} [definable_fam S Y] [definable_fam S Z] :
  definable_fam S (λ x, Y x → Z x) :=
sorry

instance subtype {X : Type*} [definable_psh S X] : definable_fam S (λ (s : set X), s) :=
sorry

example : definable S ((λ x hx₁ hx₂, choice x hx₁) : Π (X : set R), X.nonempty → X.nonempty → X) :=
sorry

-- can we do without this `definable_fam` stuff? even as a hack?
-- or maybe stick with this for now?

/- TODO:
* class represented [has_coordinates R X] expressing compatibility
* prove this notion of definability of functions, sets reduces
  to the original one in the represented case
Then:
* prove stuff like `is_least : set R → R → Prop` is definable
-/

end o_minimal


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Extra facts about `pprod`
-/

@[simp] theorem pprod.mk.eta {α : Sort u_1} {β : Sort u_2} {p : PProd α β} :
    { fst := pprod.fst p, snd := pprod.snd p } = p :=
  pprod.cases_on p fun (a : α) (b : β) => rfl

end Mathlib


import tactic.interactive

example (b : bool) (h : b = tt) : true :=
begin
  let b₁ : bool := b,
  /-
  This test shows that `tactic.revert_target_deps`
  will revert `b₁` because it occurse in the `have` statement below,
  but recursively also reverts `b` (and hence `h`),
  because `b` occurs in the body of the `let` statement that introduces `b₁`,
  even though `b` doesn't occur directly in the `have` statement below.
  -/
  have : ∀ b₂ : bool, b₂ ≠ b₁ → b₂ = ff,
  { revert_target_deps,
    tactic.interactive.guard_target
      ``(∀ (b : bool), b = tt → (let b₁ : bool := b in ∀ (b₂ : bool), b₂ ≠ b₁ → b₂ = ff)),
    exact dec_trivial },
  trivial
end


import tactic.linarith
import category_theory.shift
import algebra.homology.homological_complex
import algebra.homology.homotopy_category
import for_mathlib.category_theory.quotient_shift
import for_mathlib.algebra.homology.hom_complex
import for_mathlib.category_theory.shift_misc

noncomputable theory

open category_theory category_theory.category category_theory.limits

variables (C : Type*) [category C] [preadditive C]

namespace cochain_complex

open homological_complex

local attribute [simp] X_iso_of_eq_hom_naturality X_iso_of_eq_inv_naturality

@[simps obj_d map_f]
def shift_functor (n : ℤ) : cochain_complex C ℤ ⥤ cochain_complex C ℤ :=
{ obj := λ K,
  { X := λ i, K.X (i+n),
    d := λ i j, cochain_complex.hom_complex.ε n • K.d _ _,
    shape' := λ i j hij, begin
      rw [K.shape, smul_zero],
      intro hij',
      apply hij,
      dsimp [complex_shape.up] at hij' ⊢,
      linarith,
    end, },
  map := λ K₁ K₂ φ,
  { f := λ i, φ.f _, }, }

variable {C}

@[simp]
lemma X_iso_of_eq_of_shift_functor (K : cochain_complex C ℤ) (n : ℤ) {i i' : ℤ} (h : i = i') :
  ((shift_functor C n).obj K).X_iso_of_eq h = K.X_iso_of_eq (by subst h) := rfl

@[simp]
def shift_functor_obj_X_iso (K : cochain_complex C ℤ) (n i m : ℤ) (hm : m = i + n) :
  ((shift_functor C n).obj K).X i ≅ K.X m :=
X_iso_of_eq K hm.symm

variable (C)

@[simp]
def shift_functor_congr {n n' : ℤ} (h : n = n') :
  shift_functor C n ≅ shift_functor C n' :=
nat_iso.of_components
  (λ K, hom.iso_of_components (λ i, K.X_iso_of_eq (by subst h))
  (λ i j hij, by { dsimp, simp [h], })) (λ K₁ K₂ φ, by { ext, dsimp, simp, })

@[simps]
def shift_functor_zero' (n : ℤ) (h : n = 0) :
  shift_functor C n ≅ 𝟭 _ :=
nat_iso.of_components (λ K, hom.iso_of_components
  (λ i, K.shift_functor_obj_X_iso _ _ _ (by linarith))
    (by { subst h, tidy, })) (by tidy)

@[simps]
def shift_functor_add' (n₁ n₂ n₁₂ : ℤ) (h : n₁₂ = n₁ + n₂) :
  shift_functor C n₁ ⋙ shift_functor C n₂ ≅ shift_functor C n₁₂ :=
nat_iso.of_components
  (λ K, hom.iso_of_components (λ i, K.X_iso_of_eq (by linarith))
  (λ i j hij, begin
    subst h,
    dsimp,
    simp only [linear.comp_smul, X_iso_of_eq_hom_comp_d, linear.smul_comp,
      d_comp_X_iso_of_eq_hom, ← mul_smul, ← cochain_complex.hom_complex.ε_add, add_comm n₁],
  end)) (by tidy)

instance : has_shift (cochain_complex C ℤ) ℤ :=
has_shift_mk _ _
{ F := shift_functor C,
  ε := (shift_functor_zero' C _ rfl).symm,
  μ := λ n₁ n₂, shift_functor_add' C n₁ n₂ _ rfl,
  associativity := λ n₁ n₂ n₃ K, by { ext i, dsimp [X_iso_of_eq], simp, }, }

variable {C}

@[simp]
lemma shift_functor_map_f' {K L : cochain_complex C ℤ} (φ : K ⟶ L) (n p : ℤ) :
  ((category_theory.shift_functor (cochain_complex C ℤ) n).map φ).f p = φ.f (p+n) := rfl

@[simp]
lemma shift_functor_obj_d' (K : cochain_complex C ℤ) (n i j : ℤ) :
  ((category_theory.shift_functor (cochain_complex C ℤ) n).obj K).d i j =
    cochain_complex.hom_complex.ε n • K.d _ _ := rfl

lemma shift_functor_add_inv_app_f (K : cochain_complex C ℤ) (a b n : ℤ) :
  ((shift_functor_add (cochain_complex C ℤ) a b).inv.app K : _ ⟶ _).f n =
    (K.X_iso_of_eq (by { dsimp, rw [add_comm a, add_assoc],})).hom := rfl

lemma shift_functor_add_hom_app_f (K : cochain_complex C ℤ) (a b n : ℤ) :
  ((shift_functor_add (cochain_complex C ℤ) a b).hom.app K : _ ⟶ _).f n =
    (K.X_iso_of_eq (by { dsimp, rw [add_comm a, add_assoc],})).inv :=
begin
  haveI : is_iso (((shift_functor_add (cochain_complex C ℤ) a b).inv.app K : _ ⟶ _).f n),
  { rw shift_functor_add_inv_app_f,
    apply_instance, },
  rw [← cancel_mono (((shift_functor_add (cochain_complex C ℤ) a b).inv.app K : _ ⟶ _).f n),
    ← homological_complex.comp_f, iso.hom_inv_id_app, homological_complex.id_f,
    shift_functor_add_inv_app_f, iso.inv_hom_id],
end

lemma shift_functor_add_comm_hom_app_f (K : cochain_complex C ℤ) (a b n : ℤ) :
  ((shift_functor_add_comm (cochain_complex C ℤ) a b).hom.app K : _ ⟶ _).f n =
    (K.X_iso_of_eq (by { dsimp, simp only [add_assoc, add_comm a], })).hom :=
begin
  dsimp only [shift_functor_add_comm, iso.trans, iso.symm],
  simpa only [nat_trans.comp_app, homological_complex.comp_f,
    shift_functor_add_hom_app_f, shift_functor_add_inv_app_f,
    homological_complex.X_iso_of_eq, eq_to_iso.inv, eq_to_iso.hom, eq_to_hom_app,
    homological_complex.eq_to_hom_f, eq_to_hom_trans],
end

variable (C)

lemma shift_functor_add'_eq (a b c : ℤ) (h : c = a + b) :
  category_theory.shift_functor_add' (cochain_complex C ℤ) a b c h =
    (shift_functor_add' C a b c h).symm :=
begin
  subst h,
  dsimp only [category_theory.shift_functor_add'],
  ext K n,
  dsimp only [iso.trans, shift_functor_add', nat_iso.of_components,
    nat_trans.comp_app, homological_complex.comp_f, hom.iso_of_components],
  simp only [eq_to_hom_app, eq_to_hom_f, shift_functor_add_hom_app_f,
    X_iso_of_eq, eq_to_iso, eq_to_hom_trans, eq_to_hom_refl, nat_trans.id_app,
    homological_complex.id_f, id_comp],
end

lemma shift_functor_add_eq (a b : ℤ) :
  category_theory.shift_functor_add (cochain_complex C ℤ) a b =
    (shift_functor_add' C a b _ rfl).symm :=
begin
  ext1,
  rw ← shift_functor_add'_eq,
  dsimp [category_theory.shift_functor_add'],
  rw id_comp,
end

lemma shift_functor_zero_eq  :
  (category_theory.shift_functor_zero (cochain_complex C ℤ) ℤ) =
    (shift_functor_zero' C 0 rfl) :=
begin
  change (category_theory.shift_functor_zero (cochain_complex C ℤ) ℤ).symm.symm =
    (shift_functor_zero' C 0 rfl).symm.symm,
  congr' 1,
  ext1,
  refl,
end

variables {C} {D : Type*} [category D] (F : C ⥤ D) [preadditive D] [functor.additive F]

def map_cochain_complex_shift_iso (n : ℤ) :
  shift_functor C n ⋙ F.map_homological_complex (complex_shape.up ℤ) ≅
    F.map_homological_complex (complex_shape.up ℤ) ⋙ shift_functor D n :=
nat_iso.of_components (λ K, hom.iso_of_components (λ i, iso.refl _)
  (λ i j hij, by { dsimp, rw [id_comp, comp_id, functor.map_zsmul], })) (by tidy)

instance map_cochain_complex_has_comm_shift :
  (functor.map_homological_complex F (complex_shape.up ℤ)).has_comm_shift ℤ :=
{ iso := λ n, map_cochain_complex_shift_iso F n,
  iso_zero := begin
    ext K i,
    rw [functor.comm_shift.unit_hom_app, comp_f,
      functor.map_homological_complex_map_f, shift_functor_zero_eq,
      shift_functor_zero_eq,
      shift_functor_zero'_hom_app_f, shift_functor_zero'_inv_app_f],
    dsimp [X_iso_of_eq],
    simpa only [eq_to_hom_map, eq_to_hom_trans],
  end,
  iso_add := λ a b, begin
    ext K i,
    simp only [functor.comm_shift.add_hom_app, comp_f, iso.symm_inv,
      functor.map_homological_complex_map_f, shift_functor_add_eq, iso.symm_hom,
        shift_functor_add'_inv_app_f, shift_functor_add'_hom_app_f,
        shift_functor_map_f'],
    dsimp [map_cochain_complex_shift_iso, iso.refl,
      X_iso_of_eq],
    erw [eq_to_hom_map, id_comp, id_comp, eq_to_hom_trans, eq_to_hom_refl],
  end, }

end cochain_complex


class foo (F : Type) where
  foo : F

class foobar (F : outParam Type) [foo F] where
  bar : F

class C (α : Type) where
  val : α

class D (α : Type) (β : outParam Type) [C β] where
  val1 : α
  val2 : β := C.val

instance : C String where
  val := "hello"

instance : C Nat where
  val := 42

instance : D Nat String where
  val1 := 37

def f (α : Type) {β : Type} {_ : C β} [D α β] : α × β :=
  (D.val1, D.val2 α)

example : f Nat = (37, "hello") := rfl


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

/-!

This module provides functions for "closing" open terms and
creating auxiliary definitions. Here, we say a term is "open" if
it contains free/meta-variables.

The "closure" is performed by lambda abstracting the
free/meta-variables. Recall that in dependent type theory
lambda abstracting a let-variable may produce type incorrect terms.
For example, given the context
```lean
(n : Nat := 20)
(x : Vector α n)
(y : Vector α 20)
```
the term `x = y` is correct. However, its closure using lambda abstractions
is not.
```lean
fun (n : Nat) (x : Vector α n) (y : Vector α 20) => x = y
```
A previous version of this module would address this issue by
always use let-expressions to abstract let-vars. In the example above,
it would produce
```lean
let n : Nat := 20; fun (x : Vector α n) (y : Vector α 20) => x = y
```
This approach produces correct result, but produces unsatisfactory
results when we want to create auxiliary definitions.
For example, consider the context
```lean
(x : Nat)
(y : Nat := fact x)
```
and the term `h (g y)`, now suppose we want to create an auxiliary definition for `y`.
 The previous version of this module would compute the auxiliary definition
```lean
def aux := fun (x : Nat) => let y : Nat := fact x; h (g y)
```
and would return the term `aux x` as a substitute for `h (g y)`.
This is correct, but we will re-evaluate `fact x` whenever we use `aux`.
In this module, we produce
```lean
def aux := fun (y : Nat) => h (g y)
```
Note that in this particular case, it is safe to lambda abstract the let-varible `y`.
This module uses the following approach to decide whether it is safe or not to lambda
abstract a let-variable.
1) We enable zeta-expansion tracking in `MetaM`. That is, whenever we perform type checking
   if a let-variable needs to zeta expanded, we store it in the set `zetaFVarIds`.
   We say a let-variable is zeta expanded when we replace it with its value.
2) We use the `MetaM` type checker `check` to type check the expression we want to close,
   and the type of the binders.
3) If a let-variable is not in `zetaFVarIds`, we lambda abstract it.

Remark: We still use let-expressions for let-variables in `zetaFVarIds`, but we move the
`let` inside the lambdas. The idea is to make sure the auxiliary definition does not have
an interleaving of `lambda` and `let` expressions. Thus, if the let-variable occurs in
the type of one of the lambdas, we simply zeta-expand it there.
As a final example consider the context
```lean
(x_1 : Nat)
(x_2 : Nat)
(x_3 : Nat)
(x   : Nat := fact (10 + x_1 + x_2 + x_3))
(ty  : Type := Nat → Nat)
(f   : ty := fun x => x)
(n   : Nat := 20)
(z   : f 10)
```
and we use this module to compute an auxiliary definition for the term
```lean
(let y  : { v : Nat // v = n } := ⟨20, rfl⟩; y.1 + n + f x, z + 10)
```
we obtain
```lean
def aux (x : Nat) (f : Nat → Nat) (z : Nat) : Nat×Nat :=
let n : Nat := 20;
(let y : {v // v=n} := {val := 20, property := ex._proof_1}; y.val+n+f x, z+10)
```

BTW, this module also provides the `zeta : Bool` flag. When set to true, it
expands all let-variables occurring in the target expression.
-/

namespace Lean.Meta
namespace Closure

structure ToProcessElement where
  fvarId : FVarId
  newFVarId : FVarId
  deriving Inhabited

structure Context where
  zeta : Bool

structure State where
  visitedLevel          : LevelMap Level := {}
  visitedExpr           : ExprStructMap Expr := {}
  levelParams           : Array Name := #[]
  nextLevelIdx          : Nat := 1
  levelArgs             : Array Level := #[]
  newLocalDecls         : Array LocalDecl := #[]
  newLocalDeclsForMVars : Array LocalDecl := #[]
  newLetDecls           : Array LocalDecl := #[]
  nextExprIdx           : Nat := 1
  exprMVarArgs          : Array Expr := #[]
  exprFVarArgs          : Array Expr := #[]
  toProcess             : Array ToProcessElement := #[]

abbrev ClosureM := ReaderT Context $ StateRefT State MetaM

@[inline] def visitLevel (f : Level → ClosureM Level) (u : Level) : ClosureM Level := do
  if !u.hasMVar && !u.hasParam then
    pure u
  else
    let s ← get
    match s.visitedLevel.find? u with
    | some v => pure v
    | none   => do
      let v ← f u
      modify fun s => { s with visitedLevel := s.visitedLevel.insert u v }
      pure v

@[inline] def visitExpr (f : Expr → ClosureM Expr) (e : Expr) : ClosureM Expr := do
  if !e.hasLevelParam && !e.hasFVar && !e.hasMVar then
    pure e
  else
    let s ← get
    match s.visitedExpr.find? e with
    | some r => pure r
    | none   =>
      let r ← f e
      modify fun s => { s with visitedExpr := s.visitedExpr.insert e r }
      pure r

def mkNewLevelParam (u : Level) : ClosureM Level := do
  let s ← get
  let p := (`u).appendIndexAfter s.nextLevelIdx
  modify fun s => { s with levelParams := s.levelParams.push p, nextLevelIdx := s.nextLevelIdx + 1, levelArgs := s.levelArgs.push u }
  pure $ mkLevelParam p

partial def collectLevelAux : Level → ClosureM Level
  | u@(Level.succ v)   => return u.updateSucc! (← visitLevel collectLevelAux v)
  | u@(Level.max v w)  => return u.updateMax! (← visitLevel collectLevelAux v) (← visitLevel collectLevelAux w)
  | u@(Level.imax v w) => return u.updateIMax! (← visitLevel collectLevelAux v) (← visitLevel collectLevelAux w)
  | u@(Level.mvar ..)    => mkNewLevelParam u
  | u@(Level.param ..)   => mkNewLevelParam u
  | u@(Level.zero)     => pure u

def collectLevel (u : Level) : ClosureM Level := do
  -- u ← instantiateLevelMVars u
  visitLevel collectLevelAux u

def preprocess (e : Expr) : ClosureM Expr := do
  let e ← instantiateMVars e
  let ctx ← read
  -- If we are not zeta-expanding let-decls, then we use `check` to find
  -- which let-decls are dependent. We say a let-decl is dependent if its lambda abstraction is type incorrect.
  if !ctx.zeta then
    check e
  pure e

/--
  Remark: This method does not guarantee unique user names.
  The correctness of the procedure does not rely on unique user names.
  Recall that the pretty printer takes care of unintended collisions. -/
def mkNextUserName : ClosureM Name := do
  let s ← get
  let n := (`_x).appendIndexAfter s.nextExprIdx
  modify fun s => { s with nextExprIdx := s.nextExprIdx + 1 }
  pure n

def pushToProcess (elem : ToProcessElement) : ClosureM Unit :=
  modify fun s => { s with toProcess := s.toProcess.push elem }

partial def collectExprAux (e : Expr) : ClosureM Expr := do
  let collect (e : Expr) := visitExpr collectExprAux e
  match e with
  | Expr.proj _ _ s      => return e.updateProj! (← collect s)
  | Expr.forallE _ d b _ => return e.updateForallE! (← collect d) (← collect b)
  | Expr.lam _ d b _     => return e.updateLambdaE! (← collect d) (← collect b)
  | Expr.letE _ t v b _  => return e.updateLet! (← collect t) (← collect v) (← collect b)
  | Expr.app f a         => return e.updateApp! (← collect f) (← collect a)
  | Expr.mdata _ b       => return e.updateMData! (← collect b)
  | Expr.sort u          => return e.updateSort! (← collectLevel u)
  | Expr.const _ us      => return e.updateConst! (← us.mapM collectLevel)
  | Expr.mvar mvarId     =>
    let mvarDecl ← mvarId.getDecl
    let type ← preprocess mvarDecl.type
    let type ← collect type
    let newFVarId ← mkFreshFVarId
    let userName ← mkNextUserName
    modify fun s => { s with
      newLocalDeclsForMVars := s.newLocalDeclsForMVars.push $ .cdecl default newFVarId userName type .default .default,
      exprMVarArgs          := s.exprMVarArgs.push e
    }
    return mkFVar newFVarId
  | Expr.fvar fvarId =>
    match (← read).zeta, (← fvarId.getValue?) with
    | true, some value => collect (← preprocess value)
    | _,    _          =>
      let newFVarId ← mkFreshFVarId
      pushToProcess ⟨fvarId, newFVarId⟩
      return mkFVar newFVarId
  | e => pure e

def collectExpr (e : Expr) : ClosureM Expr := do
  let e ← preprocess e
  visitExpr collectExprAux e

partial def pickNextToProcessAux (lctx : LocalContext) (i : Nat) (toProcess : Array ToProcessElement) (elem : ToProcessElement)
    : ToProcessElement × Array ToProcessElement :=
  if h : i < toProcess.size then
    let elem' := toProcess.get ⟨i, h⟩
    if (lctx.get! elem.fvarId).index < (lctx.get! elem'.fvarId).index then
      pickNextToProcessAux lctx (i+1) (toProcess.set ⟨i, h⟩ elem) elem'
    else
      pickNextToProcessAux lctx (i+1) toProcess elem
  else
    (elem, toProcess)

def pickNextToProcess? : ClosureM (Option ToProcessElement) := do
  let lctx ← getLCtx
  let s ← get
  if s.toProcess.isEmpty then
    pure none
  else
    modifyGet fun s =>
      let elem      := s.toProcess.back
      let toProcess := s.toProcess.pop
      let (elem, toProcess) := pickNextToProcessAux lctx 0 toProcess elem
      (some elem, { s with toProcess := toProcess })

def pushFVarArg (e : Expr) : ClosureM Unit :=
  modify fun s => { s with exprFVarArgs := s.exprFVarArgs.push e }

def pushLocalDecl (newFVarId : FVarId) (userName : Name) (type : Expr) (bi := BinderInfo.default) : ClosureM Unit := do
  let type ← collectExpr type
  modify fun s => { s with newLocalDecls := s.newLocalDecls.push <| .cdecl default newFVarId userName type bi .default }

partial def process : ClosureM Unit := do
  match (← pickNextToProcess?) with
  | none => pure ()
  | some ⟨fvarId, newFVarId⟩ =>
    match (← fvarId.getDecl) with
    | .cdecl _ _ userName type bi _ =>
      pushLocalDecl newFVarId userName type bi
      pushFVarArg (mkFVar fvarId)
      process
    | .ldecl _ _ userName type val _ _ =>
      let zetaFVarIds ← getZetaFVarIds
      if !zetaFVarIds.contains fvarId then
        /- Non-dependent let-decl

            Recall that if `fvarId` is in `zetaFVarIds`, then we zeta-expanded it
            during type checking (see `check` at `collectExpr`).

            Our type checker may zeta-expand declarations that are not needed, but this
            check is conservative, and seems to work well in practice. -/
        pushLocalDecl newFVarId userName type
        pushFVarArg (mkFVar fvarId)
        process
      else
        /- Dependent let-decl -/
        let type ← collectExpr type
        let val  ← collectExpr val
        modify fun s => { s with newLetDecls := s.newLetDecls.push <| .ldecl default newFVarId userName type val false .default }
        /- We don't want to interleave let and lambda declarations in our closure. So, we expand any occurrences of newFVarId
           at `newLocalDecls` -/
        modify fun s => { s with newLocalDecls := s.newLocalDecls.map (·.replaceFVarId newFVarId val) }
        process

@[inline] def mkBinding (isLambda : Bool) (decls : Array LocalDecl) (b : Expr) : Expr :=
  let xs := decls.map LocalDecl.toExpr
  let b  := b.abstract xs
  decls.size.foldRev (init := b) fun i b =>
    let decl := decls[i]!
    match decl with
    | .cdecl _ _ n ty bi _ =>
      let ty := ty.abstractRange i xs
      if isLambda then
        Lean.mkLambda n bi ty b
      else
        Lean.mkForall n bi ty b
    | .ldecl _ _ n ty val nonDep _ =>
      if b.hasLooseBVar 0 then
        let ty  := ty.abstractRange i xs
        let val := val.abstractRange i xs
        mkLet n ty val b nonDep
      else
        b.lowerLooseBVars 1 1

def mkLambda (decls : Array LocalDecl) (b : Expr) : Expr :=
  mkBinding true decls b

def mkForall (decls : Array LocalDecl) (b : Expr) : Expr :=
  mkBinding false decls b

structure MkValueTypeClosureResult where
  levelParams : Array Name
  type        : Expr
  value       : Expr
  levelArgs   : Array Level
  exprArgs    : Array Expr

def mkValueTypeClosureAux (type : Expr) (value : Expr) : ClosureM (Expr × Expr) := do
  resetZetaFVarIds
  withTrackingZeta do
    let type  ← collectExpr type
    let value ← collectExpr value
    process
    pure (type, value)

def mkValueTypeClosure (type : Expr) (value : Expr) (zeta : Bool) : MetaM MkValueTypeClosureResult := do
  let ((type, value), s) ← ((mkValueTypeClosureAux type value).run { zeta := zeta }).run {}
  let newLocalDecls := s.newLocalDecls.reverse ++ s.newLocalDeclsForMVars
  let newLetDecls   := s.newLetDecls.reverse
  let type  := mkForall newLocalDecls (mkForall newLetDecls type)
  let value := mkLambda newLocalDecls (mkLambda newLetDecls value)
  pure {
    type        := type,
    value       := value,
    levelParams := s.levelParams,
    levelArgs   := s.levelArgs,
    exprArgs    := s.exprFVarArgs.reverse ++ s.exprMVarArgs
  }

end Closure

/--
  Create an auxiliary definition with the given name, type and value.
  The parameters `type` and `value` may contain free and meta variables.
  A "closure" is computed, and a term of the form `name.{u_1 ... u_n} t_1 ... t_m` is
  returned where `u_i`s are universe parameters and metavariables `type` and `value` depend on,
  and `t_j`s are free and meta variables `type` and `value` depend on. -/
def mkAuxDefinition (name : Name) (type : Expr) (value : Expr) (zeta : Bool := false) (compile : Bool := true) : MetaM Expr := do
  let result ← Closure.mkValueTypeClosure type value zeta
  let env ← getEnv
  let decl := Declaration.defnDecl {
    name        := name
    levelParams := result.levelParams.toList
    type        := result.type
    value       := result.value
    hints       := ReducibilityHints.regular (getMaxHeight env result.value + 1)
    safety      := if env.hasUnsafe result.type || env.hasUnsafe result.value then DefinitionSafety.unsafe else DefinitionSafety.safe
  }
  addDecl decl
  if compile then
    compileDecl decl
  return mkAppN (mkConst name result.levelArgs.toList) result.exprArgs

/-- Similar to `mkAuxDefinition`, but infers the type of `value`. -/
def mkAuxDefinitionFor (name : Name) (value : Expr) (zeta : Bool := false) : MetaM Expr := do
  let type ← inferType value
  let type := type.headBeta
  mkAuxDefinition name type value (zeta := zeta)

end Lean.Meta


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import computational_monads.simulation_semantics.simulate.basic

/-!
# Composition of Simulation Oracles

This file defines an operator `∘ₛ` for composing two simulation oracles in the natural way,
such that simulation corresponds to a two step simulation by both.
-/

open oracle_comp oracle_spec

variables {spec spec' spec'' : oracle_spec} {α β γ : Type} {S S' : Type}

namespace sim_oracle

/-- Compose two `sim_oracles`, using the first oracle to simulate the queries of the second.
For example a random oracle is a uniform oracle composed with a cacheing oracle,
i.e. one that caches previous responses and calls a uniform random oracle for any new queries.
For type inference reasons we list the arguments in the opposite order of `function.comp`. -/
def oracle_compose (so : sim_oracle spec spec' S) (so' : sim_oracle spec' spec'' S') :
  sim_oracle spec spec'' (S × S') :=
{ default_state := (so.default_state, so'.default_state),
  o := λ i x, simulate so' (so i (x.1, x.2.1)) x.2.2 >>= λ u_s, return (u_s.1.1, u_s.1.2, u_s.2) }

-- We use `notation` over `infixl` to swap the arguments without invoking `function.comp`.
notation so' `∘ₛ` so := oracle_compose so so'

namespace oracle_compose

variables (so : sim_oracle spec spec' S) (so' : sim_oracle spec' spec'' S')

lemma apply_eq (i : spec.ι) (s : S × S') : (so' ∘ₛ so) i =
  λ x, simulate so' (so i (x.1, x.2.1)) x.2.2 >>= λ u_s, return (u_s.1.1, u_s.1.2, u_s.2) := rfl

end oracle_compose

end sim_oracle


/-
# Introduction

## What's the goal of this book?

This book aims to build up enough knowledge about metaprogramming in Lean 4 so
you can be comfortable enough to:

* Start building your own meta helpers
* Read and discuss metaprogramming API's like the ones in Lean 4 core and
Mathlib4

We by no means intend to provide an exhaustive exploration/explanation of the
entire Lean 4 metaprogramming API. We also don't cover the topic of monadic
programming in Lean 4. However, we hope that the examples provided will be
simple enough for the reader to follow and comprehend without a super deep
understanding of monadic programming. The book
[Functional Programming in Lean](https://leanprover.github.io/functional_programming_in_lean/)
is a highly recomended source on that subject.

## Book structure

The book is organized in a way to build up enough content for the chapters that
cover DSLs and tactics. Backtracking the pre-requisites for each chapter, the
dependency structure is as follows:

* "Tactics" builds on top of "Macros" and "Elaboration"
* "DSLs" builds on top of "Elaboration"
* "Macros" builds on top of "`Syntax`"
* "Elaboration" builds on top of "`Syntax`" and "`MetaM`"
* "`MetaM`" builds on top of "Expressions"

After the chapter on tactics, you find a cheat-sheet containing a wrap-up of key
concepts and functions. And after that, There are some chapters with extra
content, showing other applications of metaprogramming in Lean 4.

The rest of this chapter is a gentle introduction for what metaprogramming is,
offering some small examples to serve as appetizers for what the book shall
cover.

Note: the code snippets aren't self-contained. They are supposed to be run/read
incrementally,starting from the beginning of each chapter.

## What does it mean to be in meta?

When we write code in most programming languages such as Python, C, Java or
Scala, we usually have to stick to a pre-defined syntax otherwise the compiler
or the interpreter won't be able to figure out what we're trying to say. In
Lean, that would be defining an inductive type, implementing a function, proving
a theorem etc. The compiler, then, has to parse the code, build an abstract
syntax tree and elaborate its syntax nodes into terms that can be processed by
the language kernel. We say that such activities performed by the compiler are
done in the __meta-level__, which will be studied throughout the book. And we
also say that the common usage of the language syntax is done in the
__object-level__.

In most systems, the meta-level activities are done in a different language to
the one that we use to write code. In Isabelle, the meta-level language is ML
and Scala. In Coq, it's OCaml. In Agda it's Haskell. In Lean 4, the meta code is
mostly written in Lean itself, with a few components written in C++.

One cool thing about Lean, though, is that it allows us to define custom syntax
nodes and to implement our own meta-level routines to elaborate those in the
very same development environment that we use to perform object-level
activities. So for example, one can write their own notation to instantiate a
term of a certain type and use it right away, on the same file! This concept is
generally called
[__reflection__](https://en.wikipedia.org/wiki/Reflective_programming). We can
say that, in Lean, the meta-level is _reflected_ to the object-level.

Since the objects defined in the meta-level are not the ones we're most
interested in proving theorems about, it can sometimes be overly tedious to
prove that they are type correct. For example, we don't care about proving that
a recursive function to traverse an expression is well founded. Thus, we can
use the `partial` keyword if we're convinced that our function terminates. In
the worst case scenario, our function gets stuck in a loop but the kernel is
not reached/affected.

Let's see some example use cases of metaprogramming in Lean.

## Metaprogramming examples

The following examples are meant for mere illustration. Don't worry if you don't
understand the details for now.

### Introducing notation (defining new syntax)

Often one wants to introduce new notation, for example one more suitable for (a branch of) mathematics. For instance, in mathematics one would write the function adding `2` to a natural number as `x : Nat ↦ x + 2` or simply `x ↦ x + 2` if the domain can be inferred to be the natural numbers. The corresponding lean definitions `fun x : Nat => x + 2` and `fun x => x + 2` use `=>` which in mathematics means _implication_, so may be confusing to some.

We can introduce notation using a `macro` which transforms our syntax to lean's own syntax (or syntax we previously defined). Here we introduce the `↦` notation for functions.
-/
import Lean

macro x:ident ":" t:term " ↦ " y:term : term => do
  `(fun $x : $t => $y)

#eval (x : Nat ↦ x + 2) 2 -- 4

macro x:ident " ↦ " y:term : term => do
  `(fun $x  => $y)

#eval (x ↦  x + 2) 2 -- 4
/-!

### Building a command

Suppose we want to build a helper command `#assertType` which tells whether a
given term is of a certain type. The usage will be:

`#assertType <term> : <type>`

Let's see the code:
-/
elab "#assertType " termStx:term " : " typeStx:term : command =>
  open Lean Lean.Elab Command Term in
  liftTermElabM
    try
      let tp ← elabType typeStx
      discard $ elabTermEnsuringType termStx tp
      synthesizeSyntheticMVarsNoPostponing
      logInfo "success"
    catch | _ => throwError "failure"

#assertType 5  : Nat -- success
#assertType [] : Nat -- failure

/-! We started by using `elab` to define a `command` syntax, which, when parsed
by the compiler, will trigger the incoming computation.

At this point, the code should be running in the `CommandElabM` monad. We then
use `liftTermElabM` to access the `TermElabM` monad, which allows us to use
`elabType` and `elabTermEnsuringType` in order to build expressions out of the
syntax nodes `typeStx` and `termStx`.

First we elaborate the expected type `tp : Expr` and then we use it to elaborate
the term expression, which should have the type `tp` otherwise an error will be
thrown. The term expression itself doesn't matter to us here, as we're calling
`elabTermEnsuringType` as a sanity check.

We also add `synthesizeSyntheticMVarsNoPostponing`, which forces Lean to
elaborate metavariables right away. Without that line, `#assertType 5  : ?_`
would result in `success`.

If no error is thrown until now then the elaboration succeeded and we can use
`logInfo` to output "success". If, instead, some error is caught, then we use
`throwError` with the appropriate message.

### Building a DSL and a syntax for it

Let's parse a classic grammar, the grammar of arithmetic expressions with
addition, multiplication, naturals, and variables.  We'll define an AST
(Abstract Syntax Tree) to encode the data of our expressions, and use operators
`+` and `*` to denote building an arithmetic AST. Here's the AST that we will be
parsing:
-/

inductive Arith : Type where
  | add : Arith → Arith → Arith -- e + f
  | mul : Arith → Arith → Arith -- e * f
  | nat : Nat → Arith           -- constant
  | var : String → Arith        -- variable

/-! Now we declare a syntax category to describe the grammar that we will be
parsing. Notice that we control the precedence of `+` and `*` by giving a lower
precedence weight to the `+` syntax than to the `*` syntax indicating that
multiplication binds tighter than addition (the higher the number, the tighter
the binding). This allows us to declare _precedence_ when defining new syntax.
-/

declare_syntax_cat arith
syntax num                        : arith -- nat for Arith.nat
syntax str                        : arith -- strings for Arith.var
syntax:50 arith:50 " + " arith:51 : arith -- Arith.add
syntax:60 arith:60 " * " arith:61 : arith -- Arith.mul
syntax " ( " arith " ) "          : arith -- bracketed expressions

-- Auxiliary notation for translating `arith` into `term`
syntax " ⟪ " arith " ⟫ " : term

-- Our macro rules perform the "obvious" translation:
macro_rules
  | `(⟪ $s:str ⟫)              => `(Arith.var $s)
  | `(⟪ $num:num ⟫)            => `(Arith.nat $num)
  | `(⟪ $x:arith + $y:arith ⟫) => `(Arith.add ⟪ $x ⟫ ⟪ $y ⟫)
  | `(⟪ $x:arith * $y:arith ⟫) => `(Arith.mul ⟪ $x ⟫ ⟪ $y ⟫)
  | `(⟪ ( $x ) ⟫)              => `( ⟪ $x ⟫ )

#check ⟪ "x" * "y" ⟫
-- Arith.mul (Arith.var "x") (Arith.var "y") : Arith

#check ⟪ "x" + "y" ⟫
-- Arith.add (Arith.var "x") (Arith.var "y") : Arith

#check ⟪ "x" + 20 ⟫
-- Arith.add (Arith.var "x") (Arith.nat 20) : Arith

#check ⟪ "x" + "y" * "z" ⟫ -- precedence
-- Arith.add (Arith.var "x") (Arith.mul (Arith.var "y") (Arith.var "z")) : Arith

#check ⟪ "x" * "y" + "z" ⟫ -- precedence
-- Arith.add (Arith.mul (Arith.var "x") (Arith.var "y")) (Arith.var "z") : Arith

#check ⟪ ("x" + "y") * "z" ⟫ -- brackets
-- Arith.mul (Arith.add (Arith.symbol "x") (Arith.symbol "y")) (Arith.symbol "z")

/-!
### Writing our own tactic

Let's create a tactic that adds a new hypothesis to the context with a given
name and postpones the need for its proof to the very end. It's similar to
the `suffices` tactic from Lean 3, except that we want to make sure that the new
goal goes to the bottom of the goal list.

It's going to be called `suppose` and is used like this:

`suppose <name> : <type>`

So let's see the code:
-/

open Lean Meta Elab Tactic Term in
elab "suppose " n:ident " : " t:term : tactic => do
  let n : Name := n.getId
  let mvarId ← getMainGoal
  mvarId.withContext do
    let t ← elabType t
    let p ← mkFreshExprMVar t MetavarKind.syntheticOpaque n
    let (_, mvarIdNew) ← intro1P $ ← mvarId.assert n t p
    replaceMainGoal [p.mvarId!, mvarIdNew]
  evalTactic $ ← `(tactic|rotate_left)

example : 0 + a = a := by
  suppose add_comm : 0 + a = a + 0
  rw [add_comm]; rfl     -- closes the initial main goal
  rw [Nat.zero_add]; rfl -- proves `add_comm`

/-! We start by storing the main goal in `mvarId` and using it as a parameter of
`withMVarContext` to make sure that our elaborations will work with types that
depend on other variables in the context.

This time we're using `mkFreshExprMVar` to create a metavariable expression for
the proof of `t`, which we can introduce to the context using `intro1P` and
`assert`.

To require the proof of the new hypothesis as a goal, we call `replaceMainGoal`
passing a list with `p.mvarId!` in the head. And then we can use the
`rotate_left` tactic to move the recently added top goal to the bottom.

## Printing Messages

In the `#assertType` example, we used `logInfo` to make our command print
something. If, instead, we just want to perform a quick debug, we can use
`dbg_trace`.

They behave a bit differently though, as we can see below:
-/

elab "traces" : tactic => do
  let array := List.replicate 2 (List.range 3)
  Lean.logInfo m!"logInfo: {array}"
  dbg_trace f!"dbg_trace: {array}"

example : True := by -- `example` is underlined in blue, outputting:
                     -- dbg_trace: [[0, 1, 2], [0, 1, 2]]
  traces -- now `traces` is underlined in blue, outputting
         -- logInfo: [[0, 1, 2], [0, 1, 2]]
  trivial


/-
Copyright (c) 2021-2023 by the authors listed in the file AUTHORS and their
institutional affiliations. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Abdalrhman Mohamed
-/

import Smt.Reconstruction.Rewrites.Simp

namespace Smt.Reconstruction.Rewrites.Builtin

-- Equality

@[smt_simp] theorem eq_refl : (t = t) = True := eq_self t
@[smt_simp] theorem eq_symm : (t = s) = (s = t) := propext ⟨(· ▸ rfl), (· ▸ rfl)⟩

-- ITE

@[smt_simp] theorem ite_true_cond : ite True x y = x := rfl
@[smt_simp] theorem ite_false_cond : ite False x y = y := rfl
@[smt_simp] theorem ite_not_cond [h : Decidable c] : ite (Not c) x y = ite c y x :=
  h.byCases (fun hc => if_pos hc ▸ if_neg (not_not_intro hc) ▸ rfl)
            (fun hnc => if_pos hnc ▸ if_neg hnc ▸ rfl)
@[smt_simp] theorem ite_eq_branch [h : Decidable c] : ite c x x = x :=
  h.byCases (if_pos · ▸ rfl) (if_neg · ▸ rfl)

end Smt.Reconstruction.Rewrites.Builtin