import Iris.BI
import Iris.Std

namespace Iris.Proofmode
open Iris.BI Iris.Std
open Lean

/-- Single separation logic context, implemented as a list of hypotheses. A custom datatype is used
instead of the standard `List` to ensure that all operations are `reducible`. -/
inductive Env (α : Type)
  | nil  : Env α
  | cons : α → Env α → Env α

-- Env Operations
namespace Env

/-- Append a hypothesis to the end of the environment. -/
@[reducible]
def append : Env α → α → Env α
  | .nil, b       => .cons b .nil
  | .cons a as, b => .cons a <| as.append b

/-- Return whether the environment is empty, i.e. it contains no hypotheses. -/
@[reducible]
def isEmpty : Env α → Bool
  | .nil      => true
  | .cons _ _ => false

/-- Return the length of the environment, i.e. the number of contained hypotheses. -/
@[reducible]
def length : Env α → Nat
  | .nil       => 0
  | .cons _ as => as.length + 1

theorem length_cons_list_cons {a : α} {as : List α} {b : β} {bs : Env β} :
  (a :: as).length = (Env.cons b bs).length →
  as.length = bs.length
:= by
  intro h
  simp only [length, List.length] at h
  rw' [Nat.add_right_cancel h]

/-- Delete the hypothesis at the given index. -/
@[reducible]
def delete : (Γ : Env α) → Fin (Γ.length) → Env α
  | .cons _ as, ⟨0    , _⟩ => as
  | .cons a as, ⟨i + 1, h⟩ => .cons a <| as.delete ⟨i, Nat.lt_of_succ_lt_succ h⟩

/-- Return the hypothesis at a given index without removing it. -/
@[reducible]
def get : (Γ : Env α) → Fin (Γ.length) → α
  | .cons a _ , ⟨0    , _⟩ => a
  | .cons _ as, ⟨i + 1, h⟩ => as.get ⟨i, Nat.lt_of_succ_lt_succ h⟩

/-- Split the environment into two disjoint environments. The given boolean mask must have the same
length as the environment. If the boolean mask contains the value `true` at a given index, the
hypothesis at the same index in the original environment is contained in the left environment in
the result. If the value is `false`, the hypothesis is contained in the right environment. -/
@[reducible]
def split : (Γ : Env α) → (mask : List Bool) → (mask.length = Γ.length) → Env α × Env α
  | .nil, .nil, _ => (.nil, .nil)
  | .cons a as, b :: bs, h =>
    let (ls, rs) := split as bs (length_cons_list_cons h)
    if b then (.cons a ls, rs) else (ls, .cons a rs)

/-- Return a list with exactly the hypotheses from the environment in the same order as in
the environment. -/
@[reducible]
def toList : Env α → List α
  | .nil       => []
  | .cons a as => a :: toList as

/-- Proposition of membership for an hypothesis in an environment. -/
inductive Mem : α → Env α → Prop
  | head (a : α) (as : Env α)         : Mem a (.cons a as)
  | tail (a : α) {b : α} (as : Env α) : Mem b as → Mem b (.cons a as)

instance : Membership α (Env α) where
  mem := Mem

instance : Coe (Env α) (List α) where
  coe := toList

delab_rule toList
  | `($_ $env) => `($env)

instance [ToString α] : ToString <| Env α where
  toString e := e.toList.toString

end Env

-- Env Theorems
theorem env_mem_cons_1 [BI PROP] {P : PROP} {Ps : Env PROP} : P ∈ Env.cons P Ps := by
  simp [Membership.mem, Env.Mem.head]

theorem env_mem_cons_2 [BI PROP] {P Q : PROP} {Ps : Env PROP} : P ∈ Ps → P ∈ Env.cons Q Ps := by
  intro h_Ps
  apply Env.Mem.tail
  exact h_Ps

theorem env_delete_cons [BI PROP] {P : PROP} {Ps : Env PROP} {i : Nat} {h : i + 1 < (Env.cons P Ps).length} :
  (Env.cons P Ps).delete ⟨i + 1, h⟩ = (Env.cons P <| Ps.delete ⟨i, Nat.lt_of_succ_lt_succ h⟩)
:= by
  rw' [Env.delete]
  · exact P
  · exact Nat.zero_lt_succ _

theorem env_get_cons [BI PROP] {P : PROP} {Ps : Env PROP} {i : Nat} {h : i + 1 < (Env.cons P Ps).length} :
  (Env.cons P Ps).get ⟨i + 1, h⟩ = Ps.get ⟨i, Nat.lt_of_succ_lt_succ h⟩
:= by
  rw' [Env.get]
  · exact Ps
  · exact Nat.zero_lt_succ _

theorem env_big_op_sep_append [BI PROP] {Γ : Env PROP} {P : PROP} : [∗] (Γ.append P) ⊣⊢ [∗] Γ ∗ P := by
  induction Γ
  <;> simp only [Env.append, Env.toList]
  case nil =>
    simp only [big_op]
    rw' [(left_id : emp ∗ _ ⊣⊢ _)]
  case cons P' _ h_ind =>
    rw' [
      !big_op_sep_cons,
      h_ind,
      ← (assoc : _ ⊣⊢ (P' ∗ _) ∗ P)]

theorem env_big_op_and_append [BI PROP] {Γ : Env PROP} {P : PROP} : □ [∧] (Γ.append P) ⊣⊢ □ [∧] Γ ∗ □ P := by
  induction Γ
  <;> simp only [Env.append, Env.toList]
  case nil =>
    simp only [big_op]
    rw' [
      intuitionistically_True_emp,
      (left_id : emp ∗ _ ⊣⊢ _)]
  case cons P' _ h_ind =>
    rw' [
      !big_op_and_cons,
      !intuitionistically_and,
      !and_sep_intuitionistically,
      h_ind,
      ← (assoc : _ ⊣⊢ (□ P' ∗ _) ∗ □ P)]

theorem env_idx_rec [BI PROP] (P : (Γ : Env PROP) → Fin Γ.length → Prop)
  (zero : ∀ {P'} {Γ'} {is_lt}, P (.cons P' Γ') ⟨0, is_lt⟩)
  (succ : ∀ {P'} {Γ'} {val} {is_lt} {is_lt'}, P Γ' ⟨val, is_lt⟩ → P (.cons P' Γ') ⟨Nat.succ val, is_lt'⟩) :
  ∀ Γ i, P Γ i
:= by
  intro Γ i
  let ⟨val, is_lt⟩ := i
  induction val generalizing Γ
  case zero =>
    cases Γ with
    | nil =>
      contradiction
    | cons P' Γ' =>
      exact zero
  case succ val h_ind =>
    cases Γ with
    | nil =>
      contradiction
    | cons P' Γ' =>
      let is_lt := Nat.lt_of_succ_lt_succ is_lt
      specialize h_ind Γ' ⟨val, is_lt⟩ is_lt
      exact succ h_ind

theorem env_big_op_sep_delete_get [BI PROP] {Γ : Env PROP} (i : Fin Γ.length) :
  [∗] Γ ⊣⊢ [∗] (Γ.delete i) ∗ (Γ.get i)
:= by
  induction Γ, i using env_idx_rec
  case zero P' _ _ =>
    rw' [
      Env.delete,
      Env.get,
      big_op_sep_cons,
      (comm : P' ∗ _ ⊣⊢ _)]
  case succ P' _ _ _ _ h_ind =>
    rw' [
      env_delete_cons,
      env_get_cons,
      !big_op_sep_cons,
      ← (assoc : _ ⊣⊢ (P' ∗ _) ∗ _),
      ← h_ind]

theorem env_big_op_and_delete_get [BI PROP] {Γ : Env PROP} (i : Fin Γ.length) :
  □ [∧] Γ ⊣⊢ □ [∧] (Γ.delete i) ∗ □ (Γ.get i)
:= by
  induction Γ, i using env_idx_rec
  case zero P' _ _ =>
    rw' [
      Env.delete,
      Env.get,
      big_op_and_cons,
      intuitionistically_and,
      and_sep_intuitionistically,
      (comm : □ P' ∗ _ ⊣⊢ _)]
  case succ P' _ _ _ _ h_ind =>
    rw' [
      env_delete_cons,
      env_get_cons,
      !big_op_and_cons,
      !intuitionistically_and,
      !and_sep_intuitionistically,
      ← (assoc : _ ⊣⊢ (□ P' ∗ _) ∗ _),
      ← h_ind]

theorem env_delete_length [BI PROP] {Γ : Env PROP} {i : Fin Γ.length} : (Γ.delete i).length = Γ.length - 1 := by
  induction Γ, i using env_idx_rec
  case zero =>
    rw [Env.delete, Env.length, Nat.add_sub_cancel]
  case succ _ _ is_lt _ h_ind =>
    rw [
      env_delete_cons,
      Env.length,
      h_ind,
      Env.length,
      Nat.add_sub_cancel,
      Nat.sub_add_cancel ?_]
    · apply Nat.succ_le_of_lt
      exact Nat.zero_lt_of_lt is_lt

theorem env_delete_idx_length [BI PROP] {Γ : Env PROP} {i : Fin Γ.length} : i ≤ (Γ.delete i).length := by
  let ⟨val, is_lt⟩ := i
  rw [env_delete_length]
  apply Nat.le_of_lt_succ
  rw [Nat.succ_eq_add_one, Nat.sub_add_cancel ?_]
  exact is_lt
  · apply Nat.succ_le_of_lt
    exact Nat.zero_lt_of_lt is_lt

theorem env_delete_idx_length_of_lt [BI PROP] {Γ : Env PROP} {i : Fin Γ.length} {j : Nat} : j < i → j < (Γ.delete i).length := by
  intro h
  apply Nat.lt_of_lt_of_le h ?_
  exact env_delete_idx_length

theorem env_delete_idx_pred_length [BI PROP] {Γ : Env PROP} (i : Fin Γ.length) (h : 0 < i.val) : ∀ {j}, (i - 1) < (Γ.delete j).length := by
  intro j
  let ⟨val, is_lt⟩ := i
  rw [env_delete_length]
  apply Nat.lt_sub_of_add_lt
  rw [Nat.sub_add_cancel]
  exact is_lt
  · apply Nat.succ_le_of_lt
    exact h

theorem env_split_cons_false [BI PROP] {P : PROP} {Ps : Env PROP} {bs : List Bool} {Γ₁ Γ₂ : Env PROP} {h : (false :: bs).length = (Env.cons P Ps).length} :
  (Γ₁, Γ₂) = (Env.cons P Ps).split (false :: bs) h →
  ∃ (Γ₂' : Env PROP), Γ₂ = Env.cons P Γ₂' ∧
  ∃ (h' : bs.length = Ps.length), (Γ₁, Γ₂') = Ps.split bs h'
:= by
  intro h_split
  simp only [Env.split] at h_split
  cases h_split
  apply Exists.intro _
  apply And.intro rfl ?_
  apply Exists.intro (Env.length_cons_list_cons h)
  simp

theorem env_split_cons_true [BI PROP] {P : PROP} {Ps : Env PROP} {bs : List Bool} {Γ₁ Γ₂ : Env PROP} {h : (true :: bs).length = (Env.cons P Ps).length} :
  (Γ₁, Γ₂) = (Env.cons P Ps).split (true :: bs) h →
  ∃ (Γ₁' : Env PROP), Γ₁ = Env.cons P Γ₁' ∧
  ∃ (h' : bs.length = Ps.length), (Γ₁', Γ₂) = Ps.split bs h'
:= by
  intro h_split
  simp only [Env.split] at h_split
  cases h_split
  apply Exists.intro _
  apply And.intro rfl ?_
  apply Exists.intro (Env.length_cons_list_cons h)
  simp

theorem env_big_op_sep_split [BI PROP] {Γ Γ₁ Γ₂ : Env PROP} {mask : List Bool} {h : mask.length = Γ.length} :
  (Γ₁, Γ₂) = Γ.split mask h →
  ([∗] Γ : PROP) ⊢ [∗] Γ₁ ∗ [∗] Γ₂
:= by
  intro h_split
  induction Γ generalizing mask Γ₁ Γ₂
  case nil =>
    cases mask
    case nil =>
      simp only [Env.split] at h_split
      cases h_split
      simp only [big_op]
      rw' [(left_id : emp ∗ _ ⊣⊢ _)]
    case cons =>
      simp only [List.length, Env.length] at h
      contradiction
  case cons P Ps h_ind =>
    cases mask
    case nil =>
      simp only [List.length, Env.length] at h
      contradiction
    case cons b bs =>
      cases b
      case false =>
        let ⟨_, h_split_P, _, h_split_Ps⟩ := env_split_cons_false h_split
        rw' [h_split_P]
        simp only [Env.toList]
        rw' [
          !big_op_sep_cons,
          (assoc : _ ∗ (P ∗ _) ⊣⊢ _),
          (comm : _ ∗ P ⊣⊢ _),
          ← (assoc : _ ⊣⊢ (P ∗ _) ∗ _),
          h_ind h_split_Ps]
      case true =>
        let ⟨_, h_split_P, _, h_split_Ps⟩ := env_split_cons_true h_split
        rw' [h_split_P]
        simp only [Env.toList]
        rw' [
          !big_op_sep_cons,
          ← (assoc : _ ⊣⊢ (P ∗ _) ∗ _),
          h_ind h_split_Ps]

/-- Combined separation logic context with two `Env` objects for the intuitionistic and
spatial context. -/
structure Envs (PROP : Type) [BI PROP] where
  intuitionistic : Env PROP
  spatial        : Env PROP

/-- Embedding of a separation logic context in form of an `Envs` object in a separation
logic proposition. -/
def of_envs [BI PROP] : Envs PROP → PROP
  | ⟨Γₚ, Γₛ⟩ => `[iprop| □ [∧] Γₚ ∗ [∗] Γₛ]

/-- Embedding of a separation logic context in form of an `Envs` object together with a separation
logic proposition in one separation logic proposition. This embedding is used in the Iris Proof
Mode where the embedded proposition is the goal of the proof. -/
def envs_entails [BI PROP] (Δ : Envs PROP) (Q : PROP) : Prop :=
  of_envs Δ ⊢ Q

/-- Types of hypotheses. -/
inductive HypothesisType
  | intuitionistic | spatial
  deriving BEq

/-- Unbounded index of a hypothesis in a combined separation logic context.

This datatype is used for convenience on the meta level only - environment operations and theorems
use the bounded dataype `EnvsIndex` instead. -/
structure HypothesisIndex where
  type : HypothesisType
  index : Nat
  length : Nat
  deriving BEq

/-- Bounded index of a hypothesis in a combined separation logic context.

The lengths of the individual contexts are used as type arguments instead of an `Envs` object to
allow for an easier syntax generation on the meta level. -/
inductive EnvsIndex (lₚ lₛ : Nat)
  | p : Fin lₚ → EnvsIndex lₚ lₛ
  | s : Fin lₛ → EnvsIndex lₚ lₛ

/-- Return the hypothesis type of the hypothesis referenced by the given index. -/
@[reducible]
def EnvsIndex.type : EnvsIndex lₚ lₛ → HypothesisType
  | .p _ => .intuitionistic
  | .s _ => .spatial

/-- Return the unbounded index value of the given index. -/
@[reducible]
def EnvsIndex.val : EnvsIndex lₚ lₛ → Nat
  | .p ⟨val, _⟩ => val
  | .s ⟨val, _⟩ => val

/-- `EnvsIndex` type for the given `Envs` object. -/
abbrev EnvsIndex.of [BI PROP] (Δ : Envs PROP) := EnvsIndex Δ.intuitionistic.length Δ.spatial.length

/-- Generate the syntax of a (bounded) `EnvsIndex` object based on an unbounded `HypothesisIndex`.
The proofs of the index bounds are generated using the tactic `decide`. -/
def HypothesisIndex.quoteAsEnvsIndex : HypothesisIndex → MetaM (TSyntax `term)
  | ⟨.intuitionistic, index, length⟩ =>
    ``(EnvsIndex.p ⟨$(quote index), by show $(quote index) < $(quote length) ; decide⟩)
  | ⟨.spatial, index, length⟩ =>
    ``(EnvsIndex.s ⟨$(quote index), by show $(quote index) < $(quote length) ; decide⟩)

-- Envs Operations
namespace Envs

/-- Append a hypothesis to the end of one of the separation logic contexts. The boolean flag
indicates whether the hypothesis should be appended to the intuitionistic (`true`) or spatial
(`false`) context. -/
@[reducible]
def append [BI PROP] : Bool → PROP → Envs PROP → Envs PROP
  | true,  P, ⟨Γₚ, Γₛ⟩ => ⟨Γₚ.append P, Γₛ⟩
  | false, P, ⟨Γₚ, Γₛ⟩ => ⟨Γₚ, Γₛ.append P⟩

/-- Delete the hypothesis at the given (combined) index. The boolean flag indicates whether the
hypothesis should be deleted even if it is part of the intuitionistic context. -/
@[reducible]
def delete [BI PROP] : Bool → (Δ : Envs PROP) → EnvsIndex.of Δ → Envs PROP
  | true , ⟨Γₚ, Γₛ⟩, .p i => ⟨Γₚ.delete i, Γₛ⟩
  | false, ⟨Γₚ, Γₛ⟩, .p _ => ⟨Γₚ, Γₛ⟩
  | _    , ⟨Γₚ, Γₛ⟩, .s i => ⟨Γₚ, Γₛ.delete i⟩

/-- Return the hypothesis at the given index. -/
@[reducible]
def lookup [BI PROP] : (Δ : Envs PROP) → EnvsIndex.of Δ → Bool × PROP
  | ⟨Γₚ, _⟩, .p i => (true, Γₚ.get i)
  | ⟨_, Γₛ⟩, .s i => (false, Γₛ.get i)

/-- Replace the hypothesis at index `i` with the hypothesis `P`. The boolean flag `p` indicates
whether the new hypothesis should be placed in the intuitionistic (`true`) or spatial (`false`)
context. If the boolean flag `rp` is set, the original hypothesis is removed even if it is part of
the intuitionistic context. If it is not set, the original hypothesis is kept. The new hypothesis
is added in both cases. -/
@[reducible]
def replace [BI PROP] (Δ : Envs PROP) (rp : Bool) (i : EnvsIndex.of Δ) (p : Bool) (P : PROP) : Envs PROP :=
  Δ.delete rp i |>.append p P

/-- Split the spatial context into two disjoint parts. See `Env.split` for details. -/
@[reducible]
def split [BI PROP] : (Δ : Envs PROP) → (mask : List Bool) → (mask.length = Δ.spatial.length) → Envs PROP × Envs PROP
  | ⟨Γₚ, Γₛ⟩, mask, h =>
    let ⟨Γₛ₁, Γₛ₂⟩ := Γₛ.split mask h
    (⟨Γₚ, Γₛ₁⟩, ⟨Γₚ, Γₛ₂⟩)

/-- Update an index `j` of `Δ` to reference the same hypothesis in `Δ.delete rp i`, i.e. after the
hypothesis at index `i` has been deleted. The indices `i` and `j` must reference
different hypotheses. -/
@[reducible]
def updateIndexAfterDelete [BI PROP] (Δ : Envs PROP) : (rp : Bool) → (i : EnvsIndex.of Δ) → (j : EnvsIndex.of Δ) → (i.type = j.type → i.val ≠ j.val) → EnvsIndex.of (Δ.delete rp i)
  | rp, .p i, .s ⟨val, is_lt⟩, _ =>
    .s ⟨val, by cases rp <;> simp [is_lt]⟩
  | _, .s i, .p ⟨val, is_lt⟩, _ =>
    .p ⟨val, by simp [delete, is_lt]⟩
  | false, .p _, .p ⟨val, is_lt⟩, _ =>
    .p ⟨val, by simp [delete, is_lt]⟩
  | true, .p ⟨val_d, is_lt_d⟩, .p ⟨val, is_lt⟩, h_ne =>
    if h_lt : val < val_d then
      EnvsIndex.p ⟨val, env_delete_idx_length_of_lt h_lt⟩
    else if h_gt : val_d < val then
      EnvsIndex.p ⟨val - 1, env_delete_idx_pred_length ⟨val, is_lt⟩ (Nat.zero_lt_of_lt h_gt)⟩
    else by
      let h_ne := h_ne (by simp)
      let h_eq := Nat.eq_of_not_lt_not_lt h_gt h_lt
      contradiction
  | rp, .s ⟨val_d, is_lt_d⟩, .s ⟨val, is_lt⟩, h_ne =>
    if h_lt : val < val_d then
      EnvsIndex.s ⟨val, by simp only [delete] ; exact env_delete_idx_length_of_lt h_lt⟩
    else if h_gt : val_d < val then
      EnvsIndex.s ⟨val - 1, by simp only [delete] ; exact env_delete_idx_pred_length ⟨val, is_lt⟩ (Nat.zero_lt_of_lt h_gt)⟩
    else by
      let h_ne := h_ne (by simp)
      let h_eq := Nat.eq_of_not_lt_not_lt h_gt h_lt
      contradiction

end Envs

-- Envs Theorems
theorem envs_append_sound [BI PROP] {Δ : Envs PROP} (p : Bool) (Q : PROP) :
  of_envs Δ ⊢ □?p Q -∗ of_envs (Δ.append p Q)
:= by
  apply wand_intro_l ?_
  cases p
  <;> simp only [bi_intuitionistically_if, ite_true, ite_false, of_envs]
  case false =>
    rw' [
      env_big_op_sep_append,
      (assoc : _ ∗ (_ ∗ Q) ⊣⊢ _),
      (comm : _ ∗ Q ⊣⊢ _)]
  case true =>
    rw' [
      env_big_op_and_append,
      (comm : _ ∗ □ Q ⊣⊢ _),
      ← (assoc : _ ⊣⊢ (□ Q ∗ _) ∗ _)]

theorem envs_lookup_delete_sound [BI PROP] {Δ : Envs PROP} {i : EnvsIndex.of Δ} {p : Bool} {P : PROP} (rp : Bool) :
  Δ.lookup i = (p, P) →
  of_envs Δ ⊢ □?p P ∗ of_envs (Δ.delete rp i)
:= by
  cases i
  all_goals
    simp only [Envs.lookup]
    intro h_lookup
    cases h_lookup
    simp only [Envs.delete, of_envs, bi_intuitionistically_if, ite_true, ite_false]
  case s i =>
    rw' [
      (comm : Δ.spatial.get i ∗ _ ⊣⊢ _),
      ← (assoc : _ ⊣⊢ _ ∗ _),
      ← env_big_op_sep_delete_get]
  case p i =>
    cases rp
    <;> simp only
    case true =>
      rw' [
        (assoc : _ ∗ _ ⊣⊢ _),
        (comm : □ Δ.intuitionistic.get i ∗ _ ⊣⊢ _),
        ← env_big_op_and_delete_get i]
    case false =>
      rw' [
        (assoc : _ ∗ _ ⊣⊢ _),
        (comm : □ Δ.intuitionistic.get i ∗ _ ⊣⊢ _),
        env_big_op_and_delete_get i,
        ← (assoc : _ ⊣⊢ (_ ∗ _) ∗ □ Δ.intuitionistic.get i),
        ← intuitionistically_sep_dup]

theorem envs_lookup_replace_sound [BI PROP] {Δ : Envs PROP} {i : EnvsIndex.of Δ} {p : Bool} {P : PROP} (rp : Bool) (q : Bool) (Q : PROP) :
  Δ.lookup i = (p, P) →
  of_envs Δ ⊢ □?p P ∗ (□?q Q -∗ of_envs (Δ.replace rp i q Q))
:= by
  intro h_lookup
  simp only [Envs.replace]
  rw' [
    ← envs_append_sound q Q,
    ← envs_lookup_delete_sound rp h_lookup]

theorem envs_split_env_spatial_split [BI PROP] {Δ Δ₁ Δ₂ : Envs PROP} {mask : List Bool} {h : mask.length = Δ.spatial.length} :
  Envs.split Δ mask h = (Δ₁, Δ₂) →
  Δ₁.intuitionistic = Δ.intuitionistic ∧
  Δ₂.intuitionistic = Δ.intuitionistic ∧
  (Δ₁.spatial, Δ₂.spatial) = Env.split Δ.spatial mask h
:= by
  simp only [Envs.split]
  intro h_split
  cases h_split
  <;> simp

theorem envs_split_sound [BI PROP] {Δ Δ₁ Δ₂ : Envs PROP} {mask : List Bool} {h : mask.length = Δ.spatial.length} :
  Δ.split mask h = (Δ₁, Δ₂) →
  of_envs Δ ⊢ of_envs Δ₁ ∗ of_envs Δ₂
:= by
  intro h_split_Δ
  let ⟨h_split_Γₚ₁, h_split_Γₚ₂, h_split_Γₛ⟩ := envs_split_env_spatial_split h_split_Δ
  simp only [of_envs]
  rw' [
    h_split_Γₚ₁,
    h_split_Γₚ₂,
    env_big_op_sep_split h_split_Γₛ,
    (assoc : _ ∗ (□ _ ∗ _) ⊣⊢ _),
    (comm : _ ∗ □ _ ⊣⊢ _),
    (assoc : □ _ ∗ (□ _ ∗ _) ⊣⊢ _),
    ← intuitionistically_sep_dup,
    ← (assoc : _ ⊣⊢ (_ ∗ _) ∗ _)]

theorem envs_spatial_is_empty_intuitionistically [BI PROP] {Δ : Envs PROP} :
  Δ.spatial.isEmpty = true →
  of_envs Δ ⊢ □ of_envs Δ
:= by
  simp only [Env.isEmpty, of_envs]
  cases Δ.spatial
  <;> simp [big_op]
  rw' [
    (right_id : _ ∗ emp ⊣⊢ _),
    intuitionistically_idemp]

-- AffineEnv
class AffineEnv [BI PROP] (Γ : Env PROP) where
  affineEnv : ∀ P, P ∈ Γ → Affine P
export AffineEnv (affineEnv)

instance affineEnvNil [BI PROP] :
  AffineEnv (PROP := PROP) .nil
where
  affineEnv := by
    intro _ h
    cases h

instance affineEnvConcat [BI PROP] (P : PROP) (Γ : Env PROP) :
  [Affine P] →
  [AffineEnv Γ] →
  AffineEnv (.cons P Γ)
where
  affineEnv := by
    intro P h
    cases h
    case head =>
      exact ⟨affine⟩
    case tail h =>
      exact affineEnv P h

instance (priority := default + 10) affineEnvBi (Γ : Env PROP) :
  [BIAffine PROP] →
  AffineEnv Γ
where
  affineEnv := by
    intro P _
    exact BIAffine.affine P

scoped instance affineEnvSpatial [BI PROP] (Γ : Env PROP)
  [inst : AffineEnv Γ] :
  Affine (`[iprop| [∗] Γ] : PROP)
where
  affine := by
    induction Γ generalizing inst
    case nil =>
      rw' [big_op_sep_nil]
    case cons P Ps h_ind =>
      have : AffineEnv Ps := ⟨by
        intro P h_Ps
        exact inst.affineEnv P (env_mem_cons_2 h_Ps)⟩
      have : Affine P := inst.affineEnv P env_mem_cons_1
      rw' [big_op_sep_cons, h_ind, affine]

end Iris.Proofmode


import .love05_inductive_predicates_demo

/-! # LoVe Demo 7: Metaprogramming

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) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Lean.Meta.CongrTheorems
import Lean.Meta.Tactic.Assert
import Lean.Meta.Tactic.Apply
import Lean.Meta.Tactic.Clear
import Lean.Meta.Tactic.Refl
import Lean.Meta.Tactic.Assumption

namespace Lean
open Meta

/--
Preprocessor before applying congruence theorem.
Tries to close new goals using `Eq.refl`, `HEq.refl`, and `assumption`.
It also tries to apply `heq_of_eq`.
-/
def MVarId.congrPre (mvarId : MVarId) : MetaM (Option MVarId) := do
  let mvarId ← mvarId.heqOfEq
  try mvarId.refl; return none catch _ => pure ()
  try mvarId.hrefl; return none catch _ => pure ()
  if (← mvarId.assumptionCore) then return none
  return some mvarId

/--
Asserts the given congruence theorem as fresh hypothesis, and then applies it.
Return the `fvarId` for the new hypothesis and the new subgoals.
-/
private def applyCongrThm? (mvarId : MVarId) (congrThm : CongrTheorem) : MetaM (List MVarId) := do
  let mvarId ← mvarId.assert (← mkFreshUserName `h_congr_thm) congrThm.type congrThm.proof
  let (fvarId, mvarId) ← mvarId.intro1P
  let mvarIds ← mvarId.apply (mkFVar fvarId) { synthAssignedInstances := false }
  mvarIds.mapM fun mvarId => mvarId.tryClear fvarId

/--
Try to apply a `simp` congruence theorem.
-/
def MVarId.congr? (mvarId : MVarId) : MetaM (Option (List MVarId)) :=
  mvarId.withContext do commitWhenSomeNoEx? do
    mvarId.checkNotAssigned `congr
    let target ← mvarId.getType'
    let some (_, lhs, _) := target.eq? | return none
    let lhs := lhs.cleanupAnnotations
    unless lhs.isApp do return none
    let some congrThm ← mkCongrSimp? lhs.getAppFn (subsingletonInstImplicitRhs := false) | return none
    applyCongrThm? mvarId congrThm

/--
Try to apply a `hcongr` congruence theorem, and then tries to close resulting goals
using `Eq.refl`, `HEq.refl`, and assumption.
-/
def MVarId.hcongr? (mvarId : MVarId) : MetaM (Option (List MVarId)) := do
  commitWhenSomeNoEx? do
    mvarId.checkNotAssigned `congr
    let mvarId ← mvarId.eqOfHEq
    mvarId.withContext do
      let target ← mvarId.getType'
      let some (_, lhs, _, _) := target.heq? | return none
      let lhs := lhs.cleanupAnnotations
      unless lhs.isApp do return none
      let congrThm ← mkHCongr lhs.getAppFn
      applyCongrThm? mvarId congrThm

/--
Try to apply `implies_congr`.
-/
def MVarId.congrImplies? (mvarId : MVarId) : MetaM (Option (List MVarId)) :=
  observing? do
    let mvarId₁ :: mvarId₂ :: _ ← mvarId.apply (← mkConstWithFreshMVarLevels ``implies_congr) | throwError "unexpected number of goals"
    return [mvarId₁, mvarId₂]

/--
Given a goal of the form `⊢ f as = f bs`, `⊢ (p → q) = (p' → q')`, or `⊢ HEq (f as) (f bs)`, try to apply congruence.
It takes proof irrelevance into account, and the fact that `Decidable p` is a subsingleton.
-/
def MVarId.congrCore (mvarId : MVarId) : MetaM (List MVarId) := do
  if let some mvarIds ← mvarId.congr? then
    pure mvarIds
  else if let some mvarIds ← mvarId.hcongr? then
    pure mvarIds
  else if let some mvarIds ← mvarId.congrImplies? then
    pure mvarIds
  else
    throwTacticEx `congr mvarId "failed to apply congruence"

/--
Given a goal of the form `⊢ f as = f bs`, `⊢ (p → q) = (p' → q')`, or `⊢ HEq (f as) (f bs)`, try to apply congruence.
It takes proof irrelevance into account, and the fact that `Decidable p` is a subsingleton.

* Applies `congr` recursively up to depth `depth`.
* If `closePre := true`, it will attempt to close new goals
  using `Eq.refl`, `HEq.refl`, and `assumption` with reducible transparency.
* If `closePost := true`, it will try again on goals on which `congr` failed to make progress
  with default transparency.
-/
def MVarId.congrN (mvarId : MVarId) (depth : Nat := 1000000) (closePre := true) (closePost := true) : MetaM (List MVarId) := do
  let (_, s) ← go depth mvarId |>.run #[]
  return s.toList
where
  post (mvarId : MVarId) : StateRefT (Array MVarId) MetaM Unit := do
    if closePost && (← getTransparency) != .reducible then
      if let some mvarId ← mvarId.congrPre then
        modify (·.push mvarId)
    else
      modify (·.push mvarId)

  go (n : Nat) (mvarId : MVarId) : StateRefT (Array MVarId) MetaM Unit := do
    if let some mvarId ← if closePre then withReducible mvarId.congrPre else pure mvarId then
      match n with
      | 0 => post mvarId
      | n+1 =>
        let some mvarIds ← observing? (m := MetaM) mvarId.congrCore
          | post mvarId
        mvarIds.forM (go n)


import basic

/--
# How to play
The tactic `mk_random_game` will generate a random number between 1 and 100. You can then use the
tactic `guess n` to guess a random number. If you get it right the goal will be solved otherwise it
will add a hypothesis saying whether you were too high or too low. You have 7 guesses.
 -/
example : true :=
begin
  mk_random_game,
  {
    guess 10,
    guess 20,
    guess 30,
    guess 40,
    guess 50,
    guess 60,
  },
  trivial,
end


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon

Lemmas about traversing collections.

Inspired by:

    The Essence of the Iterator Pattern
    Jeremy Gibbons and Bruno César dos Santos Oliveira
    In Journal of Functional Programming. Vol. 19. No. 3&4. Pages 377−402. 2009.
    <http://www.cs.ox.ac.uk/jeremy.gibbons/publications/iterator.pdf>
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.control.traversable.basic
import Mathlib.control.applicative
import Mathlib.PostPort

universes u

namespace Mathlib

namespace traversable

/-- The natural applicative transformation from the identity functor
to `F`, defined by `pure : Π {α}, α → F α`. -/
def pure_transformation (F : Type u → Type u) [Applicative F] [is_lawful_applicative F] : applicative_transformation id F :=
  applicative_transformation.mk pure sorry sorry

@[simp] theorem pure_transformation_apply (F : Type u → Type u) [Applicative F] [is_lawful_applicative F] {α : Type u} (x : id α) : coe_fn (pure_transformation F) α x = pure x :=
  rfl

theorem map_eq_traverse_id {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {β : Type u} {γ : Type u} (f : β → γ) : Functor.map f = traverse (id.mk ∘ f) :=
  funext fun (y : t β) => Eq.symm (is_lawful_traversable.traverse_eq_map_id f y)

theorem map_traverse {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {F : Type u → Type u} [Applicative F] [is_lawful_applicative F] {α : Type u} {β : Type u} {γ : Type u} (g : α → F β) (f : β → γ) (x : t α) : Functor.map f <$> traverse g x = traverse (Functor.map f ∘ g) x := sorry

theorem traverse_map {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {F : Type u → Type u} [Applicative F] [is_lawful_applicative F] {α : Type u} {β : Type u} {γ : Type u} (f : β → F γ) (g : α → β) (x : t α) : traverse f (g <$> x) = traverse (f ∘ g) x := sorry

theorem pure_traverse {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {F : Type u → Type u} [Applicative F] [is_lawful_applicative F] {α : Type u} (x : t α) : traverse pure x = pure x :=
  eq.mp (Eq._oldrec (Eq.refl (traverse pure x = pure (traverse id.mk x))) (is_lawful_traversable.id_traverse x))
    (Eq.symm (is_lawful_traversable.naturality (pure_transformation F) id.mk x))

theorem id_sequence {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {α : Type u} (x : t α) : sequence (id.mk <$> x) = id.mk x := sorry

theorem comp_sequence {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {F : Type u → Type u} {G : Type u → Type u} [Applicative F] [is_lawful_applicative F] [Applicative G] [is_lawful_applicative G] {α : Type u} (x : t (F (G α))) : sequence (functor.comp.mk <$> x) = functor.comp.mk (sequence <$> sequence x) := sorry

theorem naturality' {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {F : Type u → Type u} {G : Type u → Type u} [Applicative F] [is_lawful_applicative F] [Applicative G] [is_lawful_applicative G] {α : Type u} (η : applicative_transformation F G) (x : t (F α)) : coe_fn η (t α) (sequence x) = sequence (coe_fn η α <$> x) := sorry

theorem traverse_id {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {α : Type u} : traverse id.mk = id.mk := sorry

theorem traverse_comp {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {F : Type u → Type u} {G : Type u → Type u} [Applicative F] [is_lawful_applicative F] [Applicative G] [is_lawful_applicative G] {α : Type u} {β : Type u} {γ : Type u} (g : α → F β) (h : β → G γ) : traverse (functor.comp.mk ∘ Functor.map h ∘ g) = functor.comp.mk ∘ Functor.map (traverse h) ∘ traverse g := sorry

theorem traverse_eq_map_id' {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {β : Type u} {γ : Type u} (f : β → γ) : traverse (id.mk ∘ f) = id.mk ∘ Functor.map f := sorry

-- @[functor_norm]

theorem traverse_map' {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {G : Type u → Type u} [Applicative G] [is_lawful_applicative G] {α : Type u} {β : Type u} {γ : Type u} (g : α → β) (h : β → G γ) : traverse (h ∘ g) = traverse h ∘ Functor.map g := sorry

theorem map_traverse' {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {G : Type u → Type u} [Applicative G] [is_lawful_applicative G] {α : Type u} {β : Type u} {γ : Type u} (g : α → G β) (h : β → γ) : traverse (Functor.map h ∘ g) = Functor.map (Functor.map h) ∘ traverse g := sorry

theorem naturality_pf {t : Type u → Type u} [traversable t] [is_lawful_traversable t] {F : Type u → Type u} {G : Type u → Type u} [Applicative F] [is_lawful_applicative F] [Applicative G] [is_lawful_applicative G] {α : Type u} {β : Type u} (η : applicative_transformation F G) (f : α → F β) : traverse (coe_fn η β ∘ f) = coe_fn η (t β) ∘ traverse f := sorry


import .apply_fun

meta def my_first_tactic : tactic unit := tactic.trace "Hello, World."

example : true :=
begin
  my_first_tactic,
  trivial
end
meta def my_second_tactic : tactic unit :=
tactic.trace "Hello," >> tactic.trace "World."
    example : true :=
begin
  my_second_tactic,
  trivial
end
meta def my_failing_tactic  : tactic unit := tactic.failed

meta def my_failing_tactic' : tactic unit :=
tactic.fail "This tactic failed, we apologize for the inconvenience."
example : true :=
begin
  my_failing_tactic',
  trivial
end
open tactic
/-
When chaining instructions, the first failure interrupts the process.
However the orelse combinator,
 denoted by an infix <|> allows to try its right-hand side if its left-hand
 side failed. The following will successfully deliver its message.
-/

meta def my_orelse : tactic unit :=
fail "this tactic fail" <|> trace "hello"

example : true := begin
    my_orelse,
    trivial,
    end
meta def trace_goal : tactic unit :=
 tactic.target >>= tactic.trace
example (a b  : ℤ) : a = b → (a+1 = b+1)  := begin
    trace_goal, intro hyp, apply_fun  (λ t, 1+ t) at hyp,
    exact hyp,
    end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lucas Allen, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.interactive
import Mathlib.tactic.converter.interactive
import Mathlib.PostPort

namespace Mathlib

/-!
## Introduce the `apply_congr` conv mode tactic.

`apply_congr` will apply congruence lemmas inside `conv` mode.
It is particularly useful when the automatically generated congruence lemmas
are not of the optimal shape. An example, described in the doc-string is
rewriting inside the operand of a `finset.sum`.
-/

namespace conv.interactive

/--
Apply a congruence lemma inside `conv` mode.

When called without an argument `apply_congr` will try applying all lemmas marked with `@[congr]`.
Otherwise `apply_congr e` will apply the lemma `e`.

Recall that a goal that appears as `∣ X` in `conv` mode
represents a goal of `⊢ X = ?m`,
i.e. an equation with a metavariable for the right hand side.

To successfully use `apply_congr e`, `e` will need to be an equation
(possibly after function arguments),
which can be unified with a goal of the form `X = ?m`.
The right hand side of `e` will then determine the metavariable,
and `conv` will subsequently replace `X` with that right hand side.

As usual, `apply_congr` can create new goals;
any of these which are _not_ equations with a metavariable on the right hand side
will be hard to deal with in `conv` mode.
Thus `apply_congr` automatically calls `intros` on any new goals,
and fails if they are not then equations.

In particular it is useful for rewriting inside the operand of a `finset.sum`,
as it provides an extra hypothesis asserting we are inside the domain.

For example:

```lean
example (f g : ℤ → ℤ) (S : finset ℤ) (h : ∀ m ∈ S, f m = g m) :
  finset.sum S f = finset.sum S g :=
begin
  conv_lhs {
    -- If we just call `congr` here, in the second goal we're helpless,
    -- because we are only given the opportunity to rewrite `f`.
    -- However `apply_congr` uses the appropriate `@[congr]` lemma,
    -- so we get to rewrite `f x`, in the presence of the crucial `H : x ∈ S` hypothesis.
    apply_congr,
    skip,
    simp [h, H],
  }
end
```

In the above example, when the `apply_congr` tactic is called it gives the hypothesis `H : x ∈ S`
which is then used to rewrite the `f x` to `g x`.
-/
end Mathlib