/-
# The Maze Game, version 1.3.0.

## By Kevin Buzzard

An idea coming out of discussions with Kendall Frey.

# What is this game?

Four mazes and a theorem (which I must confess I haven't yet proved).

You are in a maze of twisty passages, all distinct (at this point).
Use the tactics `n`, `s`, `e`, `w` to escape.
Use the `out` tactic to get out when you're at the exit room.

# Credits

The Maze Game is brought to you by the Xena project, a project based at Imperial College London
whose aim is to get mathematics undergraduates using computer theorem provers.
Lean is a computer theorem prover being developed at Microsoft Research.

Prove a theorem. Write a function. @XenaProject.
-/


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import tactic.interactive

/-!
# Rename bound variable tactic

This files defines a tactic `rename_var` whose main purpose is to teach
renaming of bound variables.

* `rename_var old new` renames all bound variables named `old` to `new` in the goal.
* `rename_var old new at h` does the same in hypothesis `h`.

```lean
example (P : ℕ →  ℕ → Prop) (h : ∀ n, ∃ m, P n m) : ∀ l, ∃ m, P l m :=
begin
  rename_var n q at h, -- h is now ∀ (q : ℕ), ∃ (m : ℕ), P q m,
  rename_var m n, -- goal is now ∀ (l : ℕ), ∃ (n : ℕ), P k n,
  exact h -- Lean does not care about those bound variable names
end
```

## Tags

teaching, tactic
-/
open expr

/-- Rename bound variable `old` to `new` in an `expr`-/
meta def expr.rename_var (old new : name) : expr → expr
| (pi n bi t b) := (pi (if n = old then new else n) bi (expr.rename_var t) (expr.rename_var b))
| (lam n bi t b) := (lam (if n = old then new else n) bi (expr.rename_var t) (expr.rename_var b))
| (app t b) := (app (expr.rename_var t) (expr.rename_var b))
| e := e

namespace tactic
/-- Rename bound variable `old` to `new` in goal -/
meta def rename_var_at_goal (old new : name) : tactic unit :=
do
  old_tgt ← target,
  tactic.change (expr.rename_var old new old_tgt)

/-- Rename bound variable `old` to `new` in assumption `h` -/
meta def rename_var_at_hyp (old new : name) (e : expr) : tactic unit :=
do
  old_e ← infer_type e,
  tactic.change_core (expr.rename_var old new old_e) (some e)
end tactic

namespace tactic.interactive
open tactic
setup_tactic_parser

/--
`rename_var old new` renames all bound variables named `old` to `new` in the goal.
`rename_var old new at h` does the same in hypothesis `h`.
-/
meta def rename_var (old : parse ident) (new : parse ident) (l : parse location) : tactic unit :=
l.apply (rename_var_at_hyp old new) (rename_var_at_goal old new)
end tactic.interactive

/--
`rename_var old new` renames all bound variables named `old` to `new` in the goal.
`rename_var old new at h` does the same in hypothesis `h`.
This is meant for teaching bound variables only. Such a renaming should never be relevant to Lean.

```lean
example (P : ℕ →  ℕ → Prop) (h : ∀ n, ∃ m, P n m) : ∀ l, ∃ m, P l m :=
begin
  rename_var n q at h, -- h is now ∀ (q : ℕ), ∃ (m : ℕ), P q m,
  rename_var m n, -- goal is now ∀ (l : ℕ), ∃ (n : ℕ), P k n,
  exact h -- Lean does not care about those bound variable names
end
```
-/
add_tactic_doc
{ name       := "rename_var",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.rename_var],
  tags       := ["renaming"] }


/- LoVe Exercise 7: Metaprogramming -/

import .lovelib

namespace LoVe

open expr
open tactic

/- Question 1: A Term Exploder -/

/- In this exercise, we develop a string format for the `expr` metatype. By
default, there is no `has_repr` instance to print a nice string. For
example: -/

#eval (expr.app (expr.var 0) (expr.var 1) : expr)   -- result: `[external]`
#eval (`(λx : ℕ, x + x) : expr)                     -- result: `[external]`

/- 1.1. Define a metafunction `expr.repr` that converts an `expr` into a
`string`. It is acceptable to leave out some fields from the `expr`
constructors, such as the level `l` of a sort, the binder information `bi` of
a λ or Π binder, and the arguments of the `macro` constructor.

**Hint**: Use `name.to_string` to convert a name to a string, and `repr` for
other types that belong to the `has_repr` type class. -/

-- enter your definition here

/- We register `expr.repr` in the `has_repr` type class, so that we can use
`repr` without qualification in the future, and so that it is available to
`#eval`. We need the `meta` keyword in front of the command we enter. -/

meta instance : has_repr expr := ⟨expr.repr⟩

/- 1.2. Test your setup. -/

#eval (expr.app (expr.var 0) (expr.var 1) : expr)
#eval (`(λx : ℕ, x + x) : expr)

/- 1.3. Compare your answer with `expr.to_raw_fmt`. -/

#check expr.to_raw_fmt

/- Question 2: `destruct_and` on Steroids -/

/- Recall from the lecture that `destruct_and` fails on the following easy
goal: -/

example {a b c d : Prop} (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
sorry

/- We will now address this by developing a new tactic called `destro_and`,
which applies both **des**truction and in**tro**duction rules for conjunction.
It will also go automatically through the hypotheses instead of taking an
argument. We will develop it in three steps. -/

/- 2.1. Develop a tactic `intro_ands` that replaces all goals of the form
`a ∧ b` with two new goals `a` and `b` systematically, until all top-level
conjunctions are gone.

For this, we can use tactics such as `repeat` (which repeatedly applies a tactic
on all goals until the tactic fails on each of the goal) and `applyc` (which can
be used to apply a rule, in connection with backtick quoting). -/

meta def intro_ands : tactic unit :=
sorry

example {a b c d : Prop} (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
begin
  intro_ands,
  /- The proof state should be as follows:

  2 goals
  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ d -/
  repeat { sorry }
end

example {a b c d : Prop} (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
begin
  intro_ands,
  /- The proof state should be as follows:

  4 goals
  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ a

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ c

  a b c d : Prop,
  h : a ∧ (b ∧ c) ∧ d
  ⊢ b -/
  repeat { sorry }
end

/- 2.2. Develop a tactic `destruct_ands` that replaces hypotheses of the form
`h : a ∧ b` by two new hypotheses `h_left : a` and `h_right : b` systematically,
until all top-level conjunctions are gone.

Here is imperative-style pseudocode that you can follow:

1. Retrieve the list of hypotheses from the context. This is provided by the
metaconstant `local_context`.

2. Find the first hypothesis (= term) with a type (= proposition) of the form
`_ ∧ _`. Here, you can use the `list.mfirst` function, in conjunction with
pattern matching. You can use `infer_type` to query the type of a term.

3. Perform a case split on the first found hypothesis. This can be achieved
using the `cases` metafunction.

4. Go to step 1.

The above procedure might fail if there exists no hypotheses of the required
form. Make sure to handle this failure gracefully using `<|>`. -/

meta def destruct_ands : tactic unit :=
sorry

example {a b c d : Prop} (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
begin
  destruct_ands,
  /- The proof state should be as follows:

  a b c d : Prop,
  h_left : a,
  h_right_right : d,
  h_right_left_left : b,
  h_right_left_right : c
  ⊢ b ∧ d -/
  sorry
end

/- 2.3. Finally, combine the two tactics developed above and the `assumption`
tactic to implement the desired `destro_and` tactic. -/

meta def destro_and : tactic unit :=
sorry

example {a b c d : Prop} (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ d :=
by destro_and

example {a b c d : Prop} (h : a ∧ (b ∧ c) ∧ d) :
  b ∧ (a ∧ (c ∧ b)) :=
by destro_and

/- Question 3 **optional**: A Theorem Finder -/

/- We will implement a function that allows us to find theorems by constants
appearing in their statements. So given a list of constant names, the function
will list all theorems in which all these constants appear.

You can use the following metaconstants:

* `declaration` contains all data (name, type, value) associated with a
  declaration understood broadly (e.g., axiom, lemma, constant, etc.);
* `tactic.get_env` gives us access to the `environment`, a metatype thats lists
  all `declaration`s (including all theorems);
* `environment.fold` allows us to walk through the environment and collect data;
* `expr.fold` allows us to walk through an expression and collect data. -/

/- 3.1 **optional**. Write a metafunction that checks whether an expression
contains a specific constant.

You can use `expr.fold` to walk through the expression, `||` and `ff` for
Booleans, and `expr.is_constant_of` to check whether an expression is a
constant. -/

meta def term_contains (e : expr) (nam : name) : bool :=
sorry

/- 3.2 **optional**. Write a metafunction that checks whether an expression
contains _all_ constants in a list.

You can use `list.band` (Boolean and). -/

meta def term_contains_all (nams : list name) (e : expr) : bool :=
sorry

/- 3.3 **optional**. Produce the list of all theorems that contain all constants
`nams` in their statement.

`environment.fold` allows you to walk over the list of declarations. With
`declaration.type`, you get the type of a theorem, and with
`declaration.to_name` you get the name. -/

meta def list_constants (nams : list name) (e : environment) : list name :=
sorry

/- Finally, we develop a tactic that uses the above metafunctions to log all
found theorems: -/

meta def find_constants (nams : list name) : tactic unit :=
do
  env ← get_env,
  list.mmap' trace (list_constants nams env)

/- We test the solution. -/

run_cmd find_constants []   -- lists all theorems
run_cmd find_constants [`list.map, `function.comp]

end LoVe


import .lovelib

/-! # LoVe Preface

## Proof Assistants

Proof assistants (also called interactive theorem provers)

* check and help develop formal proofs;
* can be used to prove big theorems, not only logic puzzles;
* can be tedious to use;
* are highly addictive (think video games).

A selection of proof assistants, classified by logical foundations:

* set theory: Isabelle/ZF, Metamath, Mizar;
* simple type theory: HOL4, HOL Light, Isabelle/HOL;
* **dependent type theory**: Agda, Coq, **Lean**, Matita, PVS.

## Success Stories

Mathematics:

* the four-color theorem (in Coq);
* the Kepler conjecture (in HOL Light and Isabelle/HOL);
* the definition of perfectoid spaces (in Lean).

Computer science:

* hardware;
* operating systems;
* programming language theory;
* compilers;
* security.

## Lean

Lean is a proof assistant developed primarily by Leonardo de Moura (Microsoft
Research) since 2012.

Its mathematical library, `mathlib`, is developed under the leadership of
Jeremy Avigad (Carnegie Mellon University).

We use the community version of Lean 3. We use its basic libraries, `mathlib`,
and `LoVelib`. Lean is a research project.

Strengths:

* highly expressive logic based on a dependent type theory called the
  **calculus of inductive constructions**;
* extended with classical axioms and quotient types;
* metaprogramming framework;
* modern user interface;
* documentation;
* open source;
* endless source of puns (Lean Forward, Lean Together, Boolean, …).

## This Course

### Web Site

    https://lean-forward.github.io/logical-verification/2021/index.html

### Installation Instructions

    https://github.com/blanchette/logical_verification_2021/blob/main/README.md#logical-verification-2021---installation-instructions

### Repository (Demos, Exercises, Homework)

    https://github.com/blanchette/logical_verification_2021

The file you are currently looking at is a demo. There are

* 13 demo files;
* 13 exercise sheets;
* 11 homework sheets (10 points each);
* 1 project (20 points).

You may submit at most 10 homework, or at most 8 homework and the project.
Homework, including the project, must be done individually. The homework builds
on the exercises, which build on the demos.

### The Hitchhiker's Guide to Logical Verification

    https://github.com/blanchette/logical_verification_2021/blob/main/hitchhikers_guide.pdf
    https://github.com/blanchette/logical_verification_2021/blob/main/hitchhikers_guide_tablet.pdf

The lecture notes consist of a preface and 13 chapters. They cover the same
material as the corresponding lectures but with more details. Sometimes there
will not be enough time to cover everything in class, so reading the lecture
notes will be necessary.

### Final Exam

The course aims at teaching concepts, not syntax. Therefore, the final exam is
on paper. It is also closed book.

## Our Goal

We want you to

* master fundamental theory and techniques in interactive theorem proving;
* familiarize yourselves with some application areas;
* develop some practical skills you can apply on a larger project (as a hobby,
  for an MSc or PhD, or in industry);
* feel ready to move to another proof assistant and apply what you have learned;
* understand the domain well enough to start reading scientific papers.

This course is neither a pure logical foundations course nor a Lean tutorial.
Lean is our vehicle, not an end in itself.

# LoVe Demo 1: Definitions and Statements

We introduce the basics of Lean and proof assistants, without trying to carry
out actual proofs yet. We focus on specifying objects and statements of their
intended properties. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## A View of Lean

In a first approximation:

    Lean = functional programming + logic

In today's lecture, we cover inductive types, recursive functions, and lemma
statements.

If you are not familiar with typed functional programming (e.g., Haskell, ML,
OCaml, Scala), we recommend that you study a tutorial, such as the first
chapters of the online tutorial __Learn You a Haskell for Great Good!__:

    http://learnyouahaskell.com/chapters

Make sure to at least reach, and read, the section titled "Lambdas".

## Types and Terms

Similar to simply typed λ-calculus or typed functional programming languages
(ML, OCaml, Haskell).

Types `σ`, `τ`, `υ`:

* type variables `α`;
* basic types `T`;
* complex types `T σ1 … σN`.

Some type constructors `T` are written infix, e.g., `→` (function type).

The function arrow is right-associative:
`σ₁ → σ₂ → σ₃ → τ` = `σ₁ → (σ₂ → (σ₃ → τ))`.

Polymorphic types are also possible. In Lean, the type variables must be bound
using `∀`, e.g., `∀α, α → α`.

Terms `t`, `u`:

* constants `c`;
* variables `x`;
* applications `t u`;
* λ-expressions `λx, t`.

__Currying__: functions can be

* fully applied (e.g., `f x y z` if `f` is ternary);
* partially applied (e.g., `f x y`, `f x`);
* left unapplied (e.g., `f`).

Application is left-associative: `f x y z` = `((f x) y) z`. -/

#check ℕ
#check ℤ

#check empty
#check unit
#check bool

#check ℕ → ℤ
#check ℤ → ℕ
#check bool → ℕ → ℤ
#check (bool → ℕ) → ℤ
#check ℕ → (bool → ℕ) → ℤ

#check λx : ℕ, x
#check λf : ℕ → ℕ, λg : ℕ → ℕ, λh : ℕ → ℕ, λx : ℕ, h (g (f x))
#check λ(f g h : ℕ → ℕ) (x : ℕ), h (g (f x))

constants a b : ℤ
constant f : ℤ → ℤ
constant g : ℤ → ℤ → ℤ

#check λx : ℤ, g (f (g a x)) (g x b)
#check λx, g (f (g a x)) (g x b)

#check λx, x

constant trool : Type
constants trool.true trool.false trool.maybe : trool

/-! ### Type Checking and Type Inference

Type checking and type inference are decidable problems (although this property is
quickly lost if features such as overloading or subtyping are added).

Type judgment: `C ⊢ t : σ`, meaning `t` has type `σ` in local context `C`.

Typing rules:

    —————————— Cst   if c is declared with type σ
    C ⊢ c : σ

    —————————— Var   if x : σ is the last occurrence of x in C
    C ⊢ x : σ

    C ⊢ t : σ → τ    C ⊢ u : σ
    ——————————————————————————— App
    C ⊢ t u : τ

    C, x : σ ⊢ t : τ
    ———————————————————————— Lam
    C ⊢ (λx : σ, t) : σ → τ

### Type Inhabitation

Given a type `σ`, the __type inhabitation__ problem consists of finding a term
of that type. Type inhabitation is undecidable.

Recursive procedure:

1. If `σ` is of the form `τ → υ`, a candidate inhabitant is an anonymous
   function of the form `λx, _`.

2. Alternatively, you can use any constant or variable `x : τ₁ → ⋯ → τN → σ` to
   build the term `x _ … _`. -/

constants α β γ : Type

def some_fun_of_type : (α → β → γ) → ((β → α) → β) → α → γ :=
λf g a, f a (g (λb, a))

/-! ## Type Definitions

An __inductive type__ (also called __inductive datatype__,
__algebraic datatype__, or just __datatype__) is a type that consists all the
values that can be built using a finite number of applications of its
__constructors__, and only those.

### Natural Numbers -/

namespace my_nat

/-! Definition of type `nat` (= `ℕ`) of natural numbers, using Peano-style unary
notation: -/

inductive nat : Type
| zero : nat
| succ : nat → nat

#check nat
#check nat.zero
#check nat.succ

end my_nat

#print nat
#print ℕ

/-! ### Arithmetic Expressions -/

inductive aexp : Type
| num : ℤ → aexp
| var : string → aexp
| add : aexp → aexp → aexp
| sub : aexp → aexp → aexp
| mul : aexp → aexp → aexp
| div : aexp → aexp → aexp

/-! ### Lists -/

namespace my_list

inductive list (α : Type) : Type
| nil  : list
| cons : α → list → list

#check list.nil
#check list.cons

end my_list

#print list

/-! ## Function Definitions

The syntax for defining a function operating on an inductive type is very
compact: We define a single function and use __pattern matching__ to extract the
arguments to the constructors. -/

def add : ℕ → ℕ → ℕ
| m nat.zero     := m
| m (nat.succ n) := nat.succ (add m n)

#eval add 2 7
#reduce add 2 7

def mul : ℕ → ℕ → ℕ
| _ nat.zero     := nat.zero
| m (nat.succ n) := add m (mul m n)

#eval mul 2 7

#print mul
#print mul._main

def power : ℕ → ℕ → ℕ
| _ nat.zero     := 1
| m (nat.succ n) := m * power m n

#eval power 2 5

def power₂ (m : ℕ) : ℕ → ℕ
| nat.zero     := 1
| (nat.succ n) := m * power₂ n

#eval power₂ 2 5

def iter (α : Type) (z : α) (f : α → α) : ℕ → α
| nat.zero     := z
| (nat.succ n) := f (iter n)

#check iter

def power₃ (m n : ℕ) : ℕ :=
iter ℕ 1 (λl, m * l) n

#eval power₃ 2 5

def append (α : Type) : list α → list α → list α
| list.nil         ys := ys
| (list.cons x xs) ys := list.cons x (append xs ys)

#check append
#eval append _ [3, 1] [4, 1, 5]

def append₂ {α : Type} : list α → list α → list α
| list.nil         ys := ys
| (list.cons x xs) ys := list.cons x (append₂ xs ys)

#check append₂
#eval append₂ [3, 1] [4, 1, 5]

#check @append₂
#eval @append₂ _ [3, 1] [4, 1, 5]

/-! Aliases:

    `[]`          := `nil`
    `x :: xs`     := `cons x xs`
    `[x₁, …, xN]` := `x₁ :: … :: xN :: []` -/

def append₃ {α : Type} : list α → list α → list α
| []        ys := ys
| (x :: xs) ys := x :: append₃ xs ys

def reverse {α : Type} : list α → list α
| []        := []
| (x :: xs) := reverse xs ++ [x]

def eval (env : string → ℤ) : aexp → ℤ
| (aexp.num i)     := i
| (aexp.var x)     := env x
| (aexp.add e₁ e₂) := eval e₁ + eval e₂
| (aexp.sub e₁ e₂) := eval e₁ - eval e₂
| (aexp.mul e₁ e₂) := eval e₁ * eval e₂
| (aexp.div e₁ e₂) := eval e₁ / eval e₂

#eval eval (λs, 7) (aexp.div (aexp.var "x") (aexp.num 0))

/-! Lean only accepts the function definitions for which it can prove
termination. In particular, it accepts __structurally recursive__ functions,
which peel off exactly one constructor at a time.

## Lemma Statements

Notice the similarity with `def` commands. -/

namespace sorry_lemmas

lemma add_comm (m n : ℕ) :
  add m n = add n m :=
sorry

lemma add_assoc (l m n : ℕ) :
  add (add l m) n = add l (add m n) :=
sorry

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
sorry

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
sorry

lemma mul_add (l m n : ℕ) :
  mul l (add m n) = add (mul l m) (mul l n) :=
sorry

lemma reverse_reverse {α : Type} (xs : list α) :
  reverse (reverse xs) = xs :=
sorry

/-! Axioms are like lemmas but without proofs (`:= …`). Constant declarations
are like definitions but without bodies (`:= …`). -/

constants a b : ℤ

axiom a_less_b :
  a < b

end sorry_lemmas

end LoVe


/-
Copyright (c) 2020 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jannis Limperg
-/
import tactic.core

/-!
# Tactics About Dependencies

This module provides tactics to compute dependencies and reverse dependencies of
hypotheses. An expression `e` depends on a hypothesis `h` if `e` would not be
valid if `h` were removed from the context. For example, the expression
`e := x > 0` depends on `x`. We say that `x` is a dependency of `e` and that `e`
is a reverse dependency of `x`.

It is sometimes useful to consider *inclusive* dependency: `e` inclusively
depends on `h` iff `e` depends on `h` or `e = h` (so inclusive dependency is the
reflexive closure of regular dependency).

Note that the standard library does not use quite the same terminology:

* `kdependencies`/`kdeps` from the standard library compute reverse
  dependencies, not dependencies.
* `kdepends_on` and functions derived from it ignore local definitions and
  therefore compute a weaker dependency relation (see next section).

## Local Definitions

Determining dependencies of hypotheses is usually straightforward: a hypothesis
`r : R` depends on another hypothesis `d : D` if `d` occurs in `R`. The
implementation is more involved, however, in the presence of local definitions.
Consider this context:

```lean
n m : ℕ
k : ℕ := m
o : ℕ := k
h : o > 0
```

`h` depends on `o`, `k` and `m`, but only the dependency on `o` is syntactically
obvious. `kdepends_on` ignores this complication and claims that `h` does not
depend on `k` or `m`. We do not follow this example but process local
definitions properly. This means that if the context contains a local
definition, we need to compute the syntactic dependencies of `h`, then their
dependencies, and so on.

## Direct Dependencies

If you want to ignore local definitions while computing dependencies, this
module also provides tactics to find the *direct* dependencies of a hypothesis.
These are the hypotheses that syntactically appear in the hypothesis's type (or
value, if the hypothesis is a local definition).
-/

open native
open expr_set (local_set_to_name_set)
open name_set (local_list_to_name_set)

namespace tactic

/-! ### Direct Dependencies -/

/-! #### Checking whether hypotheses directly depend on each other -/

/--
`type_has_local_in_name_set h ns` returns true iff the type of `h` contains a
local constant whose unique name appears in `ns`.
-/
meta def type_has_local_in_name_set (h : expr) (ns : name_set) : tactic bool := do
  h_type ← infer_type h,
  pure $ h_type.has_local_in ns

/--
`type_has_local_in_set h hs` returns true iff the type of `h` contains any of
the local constants `hs`.
-/
meta def type_has_local_in_set (h : expr) (hs : expr_set) : tactic bool :=
type_has_local_in_name_set h $ local_set_to_name_set hs

/--
`type_has_local_in h hs` returns true iff the type of `h` contains any of the
local constants `hs`.
-/
meta def type_has_local_in (h : expr) (hs : list expr) : tactic bool :=
type_has_local_in_name_set h $ local_list_to_name_set hs

/--
`local_def_value_has_local_in_name_set h ns` returns true iff `h` is a local
definition whose value contains a local constant whose unique name appears in
`ns`.
-/
meta def local_def_value_has_local_in_name_set (h : expr) (ns : name_set) :
  tactic bool := do
  (some h_val) ← try_core $ local_def_value h | pure ff,
  pure $ h_val.has_local_in ns

/--
`local_def_value_has_local_in_set h hs` returns true iff `h` is a local
definition whose value contains any of the local constants `hs`.
-/
meta def local_def_value_has_local_in_set (h : expr) (hs : expr_set) :
  tactic bool :=
local_def_value_has_local_in_name_set h $ local_set_to_name_set hs

/--
`local_def_value_has_local_in h hs` returns true iff `h` is a local definition
whose value contains any of the local constants `hs`.
-/
meta def local_def_value_has_local_in (h : expr) (hs : list expr) :
  tactic bool :=
local_def_value_has_local_in_name_set h $ local_list_to_name_set hs

/--
`hyp_directly_depends_on_local_name_set h ns` is true iff the hypothesis `h`
directly depends on a hypothesis whose unique name appears in `ns`.
-/
meta def hyp_directly_depends_on_local_name_set (h : expr) (ns : name_set) :
  tactic bool :=
list.mbor
  [ type_has_local_in_name_set h ns,
    local_def_value_has_local_in_name_set h ns ]

/--
`hyp_directly_depends_on_local_set h hs` is true iff the hypothesis `h` directly
depends on any of the hypotheses `hs`.
-/
meta def hyp_directly_depends_on_local_set (h : expr) (hs : expr_set) :
  tactic bool :=
hyp_directly_depends_on_local_name_set h $ local_set_to_name_set hs

/--
`hyp_directly_depends_on_locals h hs` is true iff the hypothesis `h` directly
depends on any of the hypotheses `hs`.
-/
meta def hyp_directly_depends_on_locals (h : expr) (hs : list expr) :
  tactic bool :=
hyp_directly_depends_on_local_name_set h $ local_list_to_name_set hs

/--
`hyp_directly_depends_on_local_name_set_inclusive h ns` is true iff the
hypothesis `h` directly depends on a hypothesis whose unique name appears in
`ns` or `h`'s name appears in `ns`.
-/
meta def hyp_directly_depends_on_local_name_set_inclusive (h : expr)
  (ns : name_set) : tactic bool :=
list.mbor
  [ pure $ ns.contains h.local_uniq_name
  , hyp_directly_depends_on_local_name_set h ns ]

/--
`hyp_directly_depends_on_local_set_inclusive h ns` is true iff the hypothesis `h`
directly depends on any of the hypotheses `hs` or `h` appears in `hs`.
-/
meta def hyp_directly_depends_on_local_set_inclusive (h : expr) (hs : expr_set) :
  tactic bool :=
hyp_directly_depends_on_local_name_set_inclusive h $ local_set_to_name_set hs

/--
`hyp_directly_depends_on_locals_inclusive h ns` is true iff the hypothesis `h`
directly depends on any of the hypotheses `hs` or `h` appears in `hs`.
-/
meta def hyp_directly_depends_on_locals_inclusive (h : expr) (hs : list expr) :
  tactic bool :=
hyp_directly_depends_on_local_name_set_inclusive h $ local_list_to_name_set hs

/-! #### Computing the direct dependencies of a hypothesis -/

/--
`direct_dependency_set_of_hyp h` is the set of hypotheses that the hypothesis
`h` directly depends on. These are the hypotheses that appear in `h`'s type or
value (if `h` is a local definition).
-/
meta def direct_dependency_set_of_hyp (h : expr) : tactic expr_set := do
  t ← infer_type h,
  let deps := t.list_local_consts',
  (some val) ← try_core $ local_def_value h | pure deps,
  let deps := deps.union val.list_local_consts',
  pure deps

/--
`direct_dependency_name_set_of_hyp h` is the set of unique names of hypotheses
that the hypothesis `h` directly depends on. These are the hypotheses that
appear in `h`'s type or value (if `h` is a local definition).
-/
meta def direct_dependency_name_set_of_hyp (h : expr) : tactic name_set :=
local_set_to_name_set <$> direct_dependency_set_of_hyp h

/--
`direct_dependencies_of_hyp h` is the list of hypotheses that the hypothesis `h`
directly depends on. These are the hypotheses that appear in `h`'s type or value
(if `h` is a local definition). The dependencies are returned in no particular
order.
-/
meta def direct_dependencies_of_hyp (h : expr) : tactic (list expr) :=
rb_set.to_list <$> direct_dependency_set_of_hyp h

/--
`direct_dependency_set_of_hyp_inclusive h` is the set of hypotheses that the
hypothesis `h` directly depends on, plus `h` itself.
-/
meta def direct_dependency_set_of_hyp_inclusive (h : expr) : tactic expr_set := do
  deps ← direct_dependency_set_of_hyp h,
  pure $ deps.insert h

/--
`direct_dependency_name_set_of_hyp_inclusive h` is the set of unique names of
hypotheses that the hypothesis `h` directly depends on, plus `h` itself.
-/
meta def direct_dependency_name_set_of_hyp_inclusive (h : expr) :
  tactic name_set :=
local_set_to_name_set <$> direct_dependency_set_of_hyp_inclusive h

/--
`direct_dependencies_of_hyp_inclusive h` is the list of hypotheses that the
hypothesis `h` directly depends on, plus `h` itself. The dependencies are
returned in no particular order.
-/
meta def direct_dependencies_of_hyp_inclusive (h : expr) : tactic (list expr) :=
rb_set.to_list <$> direct_dependency_set_of_hyp_inclusive h

/-! ### Indirect/Transitive Dependencies -/

/-! #### Checking whether hypotheses depend on each other -/

/--
`hyp_depends_on_local_name_set' cache h ns` is true iff `h` depends on any of
the hypotheses whose unique names appear in `ns`. `cache` must be a set of
hypotheses known *not* to depend (even indirectly) on any of the `ns`. This is
a performance optimisation, so you can give an empty cache. The tactic also
returns an expanded cache with hypotheses which the tactic has encountered.

You probably want to use `tactic.hyp_depends_on_local_name_set` or
`tactic.hyps_depend_on_local_name_set` instead of this tactic.
-/
meta def hyp_depends_on_local_name_set' : expr_set → expr → name_set →
  tactic (bool × expr_set) := λ cache h ns, do
  ff ← pure $ cache.contains h | pure (ff, cache),
  direct_deps ← direct_dependency_set_of_hyp h,
  let has_dep := direct_deps.fold ff (λ d b, b || ns.contains d.local_uniq_name),
  ff ← pure has_dep | pure (tt, cache),
  (has_dep, cache) ← direct_deps.mfold (ff, cache) $ λ d ⟨b, cache⟩,
    if b
      then pure (tt, cache)
      else hyp_depends_on_local_name_set' cache d ns,
  if has_dep
    then pure (tt, cache)
    else pure (ff, cache.insert h)

/--
`hyp_depends_on_local_name_set h ns` is true iff the hypothesis `h` depends on
any of the hypotheses whose unique names appear in `ns`. If you need to check
dependencies of multiple hypotheses, use `tactic.hyps_depend_on_local_name_set`.
-/
meta def hyp_depends_on_local_name_set (h : expr) (ns : name_set) : tactic bool := do
  ctx_has_local_def ← context_upto_hyp_has_local_def h,
  if ctx_has_local_def
    then prod.fst <$> hyp_depends_on_local_name_set' mk_expr_set h ns
    else hyp_directly_depends_on_local_name_set h ns

/--
`hyp_depends_on_local_set h hs` is true iff the hypothesis `h` depends on
any of the hypotheses `hs`. If you need to check dependencies of multiple
hypotheses, use `tactic.hyps_depend_on_local_set`.
-/
meta def hyp_depends_on_local_set (h : expr) (hs : expr_set) : tactic bool :=
hyp_depends_on_local_name_set h $ local_set_to_name_set hs

/--
`hyp_depends_on_locals h hs` is true iff the hypothesis `h` depends on any of
the hypotheses `hs`. If you need to check dependencies of multiple hypotheses,
use `tactic.hyps_depend_on_locals`.
-/
meta def hyp_depends_on_locals (h : expr) (hs : list expr) : tactic bool :=
hyp_depends_on_local_name_set h $ local_list_to_name_set hs

/--
`hyps_depend_on_local_name_set hs ns` returns, for each `h ∈ hs`, whether `h`
depends on a hypothesis whose unique name appears in `ns`. This is the same as
(but more efficient than) calling `tactic.hyp_depends_on_local_name_set` for
every `h ∈ hs`.
-/
meta def hyps_depend_on_local_name_set (hs : list expr) (ns : name_set) :
  tactic (list bool) := do
  ctx_has_local ← context_has_local_def,
  if ctx_has_local
    then
      let go : expr → list bool × expr_set → tactic (list bool × expr_set) :=
      λ h ⟨deps, cache⟩, do {
        (h_dep, cache) ← hyp_depends_on_local_name_set' cache h ns,
        pure (h_dep :: deps, cache)
      } in
      prod.fst <$> hs.mfoldr go ([], mk_expr_map)
    else hs.mmap $ λ h, hyp_directly_depends_on_local_name_set h ns

/--
`hyps_depend_on_local_set hs is` returns, for each `h ∈ hs`, whether `h` depends
on any of the hypotheses `is`. This is the same as (but more efficient than)
calling `tactic.hyp_depends_on_local_set` for every `h ∈ hs`.
-/
meta def hyps_depend_on_local_set (hs : list expr) (is : expr_set) :
  tactic (list bool) :=
hyps_depend_on_local_name_set hs $ local_set_to_name_set is

/--
`hyps_depend_on_locals hs is` returns, for each `h ∈ hs`, whether `h` depends
on any of the hypotheses `is`. This is the same as (but more efficient than)
calling `tactic.hyp_depends_on_locals` for every `h ∈ hs`.
-/
meta def hyps_depend_on_locals (hs is : list expr) : tactic (list bool) :=
hyps_depend_on_local_name_set hs $ local_list_to_name_set is

/--
`hyp_depends_on_local_name_set_inclusive' cache h ns` is true iff the hypothesis
`h` inclusively depends on a hypothesis whose unique name appears in `ns`.
`cache` must be a set of hypotheses known *not* to depend (even indirectly) on
any of the `ns`. This is a performance optimisation, so you can give an empty
cache. The tactic also returns an expanded cache with hypotheses which the
tactic has encountered. Note that the cache records exclusive, not inclusive
dependencies.

You probably want to use `tactic.hyp_depends_on_local_name_set_inclusive` or
`tactic.hyps_depend_on_local_name_set_inclusive` instead of this tactic.
-/
meta def hyp_depends_on_local_name_set_inclusive' (cache : expr_set) (h : expr)
  (ns : name_set) : tactic (bool × expr_set) :=
if ns.contains h.local_uniq_name
  then pure (tt, cache)
  else hyp_depends_on_local_name_set' cache h ns

/--
`hyp_depends_on_local_name_set_inclusive h ns` is true iff the hypothesis `h`
inclusively depends on any of the hypotheses whose unique names appear in `ns`.
If you need to check the dependencies of multiple hypotheses, use
`tactic.hyps_depend_on_local_name_set_inclusive`.
-/
meta def hyp_depends_on_local_name_set_inclusive (h : expr) (ns : name_set) :
  tactic bool :=
list.mbor
  [ pure $ ns.contains h.local_uniq_name,
    hyp_depends_on_local_name_set h ns ]

/--
`hyp_depends_on_local_set_inclusive h hs` is true iff the hypothesis `h`
inclusively depends on any of the hypotheses `hs`. If you need to check
dependencies of multiple hypotheses, use
`tactic.hyps_depend_on_local_set_inclusive`.
-/
meta def hyp_depends_on_local_set_inclusive (h : expr) (hs : expr_set) :
  tactic bool :=
hyp_depends_on_local_name_set_inclusive h $ local_set_to_name_set hs

/--
`hyp_depends_on_locals_inclusive h hs` is true iff the hypothesis `h`
inclusively depends on any of the hypotheses `hs`. If you need to check
dependencies of multiple hypotheses, use
`tactic.hyps_depend_on_locals_inclusive`.
-/
meta def hyp_depends_on_locals_inclusive (h : expr) (hs : list expr) :
  tactic bool :=
hyp_depends_on_local_name_set_inclusive h $ local_list_to_name_set hs

/--
`hyps_depend_on_local_name_set_inclusive hs ns` returns, for each `h ∈ hs`,
whether `h` inclusively depends on a hypothesis whose unique name appears in
`ns`. This is the same as (but more efficient than) calling
`tactic.hyp_depends_on_local_name_set_inclusive` for every `h ∈ hs`.
-/
meta def hyps_depend_on_local_name_set_inclusive (hs : list expr) (ns : name_set) :
  tactic (list bool) := do
  ctx_has_local ← context_has_local_def,
  if ctx_has_local
    then
      let go : expr → list bool × expr_set → tactic (list bool × expr_set) :=
      λ h ⟨deps, cache⟩, do {
        (h_dep, cache) ← hyp_depends_on_local_name_set_inclusive' cache h ns,
        pure (h_dep :: deps, cache)
      } in
      prod.fst <$> hs.mfoldr go ([], mk_expr_map)
    else
      hs.mmap $ λ h, hyp_directly_depends_on_local_name_set_inclusive h ns

/--
`hyps_depend_on_local_set_inclusive hs is` returns, for each `h ∈ hs`, whether
`h` depends inclusively on any of the hypotheses `is`. This is the same as
(but more efficient than) calling `tactic.hyp_depends_on_local_set_inclusive`
for every `h ∈ hs`.
-/
meta def hyps_depend_on_local_set_inclusive (hs : list expr) (is : expr_set) :
  tactic (list bool) :=
hyps_depend_on_local_name_set_inclusive hs $ local_set_to_name_set is

/--
`hyps_depend_on_locals_inclusive hs is` returns, for each `h ∈ hs`, whether `h`
depends inclusively on any of the hypotheses `is`. This is the same as (but more
efficient than) calling `tactic.hyp_depends_on_locals_inclusive` for every
`h ∈ hs`.
-/
meta def hyps_depend_on_locals_inclusive (hs is : list expr) : tactic (list bool) :=
hyps_depend_on_local_name_set_inclusive hs $ local_list_to_name_set is

/-! #### Computing the dependencies of a hypothesis -/

/--
`dependency_set_of_hyp' cache h` is the set of dependencies of the hypothesis
`h`. `cache` is a map from hypotheses to all their dependencies (including
indirect dependencies). This is a performance optimisation, so you can give an
empty cache. The tactic also returns an expanded cache with hypotheses which
the tactic has encountered.

You probably want to use `tactic.dependency_set_of_hyp` or
`tactic.dependency_sets_of_hyps` instead of this tactic.
-/
meta def dependency_set_of_hyp' : expr_map expr_set → expr →
  tactic (expr_set × expr_map expr_set) := λ cache h, do
  match cache.find h with
  | some deps := pure (deps, cache)
  | none := do
    direct_deps ← direct_dependency_set_of_hyp h,
    (deps, cache) ←
      direct_deps.mfold (direct_deps, cache) $ λ h' ⟨deps, cache⟩, do {
        (deps', cache) ← dependency_set_of_hyp' cache h',
        pure (deps.union deps', cache)
      },
    pure (deps, cache.insert h deps)
  end

/--
`dependency_set_of_hyp h` is the set of dependencies of the hypothesis `h`. If
you need the dependencies of multiple hypotheses, use
`tactic.dependency_sets_of_hyps`.
-/
meta def dependency_set_of_hyp (h : expr) : tactic expr_set := do
  ctx_has_local ← context_upto_hyp_has_local_def h,
  if ctx_has_local
    then prod.fst <$> dependency_set_of_hyp' mk_expr_map h
    else direct_dependency_set_of_hyp h

/--
`dependency_name_set_of_hyp h` is the set of unique names of the dependencies of
the hypothesis `h`. If you need the dependencies of multiple hypotheses, use
`tactic.dependency_name_sets_of_hyps`.
-/
meta def dependency_name_set_of_hyp (h : expr) : tactic name_set :=
local_set_to_name_set <$> dependency_set_of_hyp h

/--
`dependencies_of_hyp h` is the list of dependencies of the hypothesis `h`.
The dependencies are returned in no particular order. If you need the
dependencies of multiple hypotheses, use `tactic.dependencies_of_hyps`.
-/
meta def dependencies_of_hyp (h : expr) : tactic (list expr) :=
rb_set.to_list <$> dependency_set_of_hyp h

/--
`dependency_sets_of_hyps hs` returns, for each `h ∈ hs`, the set of dependencies
of `h`. This is the same as (but more performant than) using
`tactic.dependency_set_of_hyp` on every `h ∈ hs`.
-/
meta def dependency_sets_of_hyps (hs : list expr) : tactic (list expr_set) := do
  ctx_has_def ← context_has_local_def,
  if ctx_has_def
    then
      let go : expr → list expr_set × expr_map expr_set →
        tactic (list expr_set × expr_map expr_set) := do
      λ h ⟨deps, cache⟩, do {
          (h_deps, cache) ← dependency_set_of_hyp' cache h,
          pure (h_deps :: deps, cache)
      } in
      prod.fst <$> hs.mfoldr go ([], mk_expr_map)
    else
      hs.mmap direct_dependency_set_of_hyp

/--
`dependency_name_sets_of_hyps hs` returns, for each `h ∈ hs`, the set of unique
names of the dependencies of `h`. This is the same as (but more performant than)
using `tactic.dependency_name_set_of_hyp` on every `h ∈ hs`.
-/
meta def dependency_name_sets_of_hyps (hs : list expr) : tactic (list name_set) :=
list.map local_set_to_name_set <$> dependency_sets_of_hyps hs

/--
`dependencies_of_hyps hs` returns, for each `h ∈ hs`, the dependencies of `h`.
The dependencies appear in no particular order in the returned lists. This is
the same as (but more performant than) using `tactic.dependencies_of_hyp` on
every `h ∈ hs`.
-/
meta def dependencies_of_hyps (hs : list expr) : tactic (list (list expr)) :=
list.map rb_set.to_list <$> dependency_sets_of_hyps hs

/--
`dependency_set_of_hyp_inclusive' cache h` is the set of dependencies of the
hypothesis `h`, plus `h` itself. `cache` is a map from hypotheses to all their
dependencies (including indirect dependencies). This is a performance
optimisation, so you can give an empty cache. The tactic also returns an
expanded cache with hypotheses which the tactic has encountered. Note that the
cache records exclusive, not inclusive dependencies.

You probably want to use `tactic.dependency_set_of_hyp_inclusive` or
`tactic.dependency_sets_of_hyps_inclusive` instead of this tactic.
-/
meta def dependency_set_of_hyp_inclusive' (cache : expr_map expr_set) (h : expr) :
  tactic (expr_set × expr_map expr_set) := do
  (deps, cache) ← dependency_set_of_hyp' cache h,
  pure (deps.insert h, cache)

/--
`dependency_set_of_hyp_inclusive h` is the set of dependencies of the hypothesis
`h`, plus `h` itself. If you need the dependencies of multiple hypotheses, use
`tactic.dependency_sets_of_hyps_inclusive`.
-/
meta def dependency_set_of_hyp_inclusive (h : expr) : tactic expr_set := do
  deps ← dependency_set_of_hyp h,
  pure $ deps.insert h

/--
`dependency_name_set_of_hyp_inclusive h` is the set of unique names of the
dependencies of the hypothesis `h`, plus the unique name of `h` itself. If you
need the dependencies of multiple hypotheses, use
`tactic.dependency_name_sets_of_hyps_inclusive`.
-/
meta def dependency_name_set_of_hyp_inclusive (h : expr) : tactic name_set :=
local_set_to_name_set <$> dependency_set_of_hyp_inclusive h

/--
`dependencies_of_hyp_inclusive h` is the list of dependencies of the hypothesis
`h`, plus `h` itself. The dependencies are returned in no particular order. If
you need the dependencies of multiple hypotheses, use
`tactic.dependencies_of_hyps_inclusive`.
-/
meta def dependencies_of_hyp_inclusive (h : expr) : tactic (list expr) :=
rb_set.to_list <$> dependency_set_of_hyp_inclusive h

/--
`dependency_sets_of_hyps_inclusive hs` returns, for each `h ∈ hs`, the
dependencies of `h`, plus `h` itself. This is the same as (but more performant
than) using `tactic.dependency_set_of_hyp_inclusive` on every `h ∈ hs`.
-/
meta def dependency_sets_of_hyps_inclusive (hs : list expr) :
  tactic (list expr_set) := do
  ctx_has_def ← context_has_local_def,
  if ctx_has_def
    then
      let go : expr → list expr_set × expr_map expr_set →
        tactic (list expr_set × expr_map expr_set) :=
      λ h ⟨deps, cache⟩, do {
        (h_deps, cache) ← dependency_set_of_hyp_inclusive' cache h,
        pure (h_deps :: deps, cache)
      } in
      prod.fst <$> hs.mfoldr go ([], mk_expr_map)
    else
      hs.mmap direct_dependency_set_of_hyp_inclusive

/--
`dependency_name_sets_of_hyps_inclusive hs` returns, for each `h ∈ hs`, the
unique names of the dependencies of `h`, plus the unique name of `h` itself.
This is the same as (but more performant than) using
`tactic.dependency_name_set_of_hyp_inclusive` on every `h ∈ hs`.
-/
meta def dependency_name_sets_of_hyps_inclusive (hs : list expr) :
  tactic (list name_set) :=
list.map local_set_to_name_set <$> dependency_sets_of_hyps_inclusive hs

/--
`dependencies_of_hyps_inclusive hs` returns, for each `h ∈ hs`, the dependencies
of `h`, plus `h` itself. The dependencies appear in no particular order in the
returned lists. This is the same as (but more performant than) using
`tactic.dependencies_of_hyp_inclusive` on every `h ∈ hs`.
-/
meta def dependencies_of_hyps_inclusive (hs : list expr) :
  tactic (list (list expr)) :=
list.map rb_set.to_list <$> dependency_sets_of_hyps_inclusive hs

/-! #### Computing the reverse dependencies of a hypothesis -/

private meta def reverse_dependencies_of_hyp_name_set_aux (hs : name_set) :
  list expr → list expr → name_set → tactic (list expr)
| [] revdeps _ := pure revdeps.reverse
| (H :: Hs) revdeps ns := do
  let H_uname := H.local_uniq_name,
  H_is_revdep ← list.mband
    [ pure $ ¬ hs.contains H_uname,
      hyp_directly_depends_on_local_name_set H ns ],
  if H_is_revdep
    then
      reverse_dependencies_of_hyp_name_set_aux Hs (H :: revdeps)
        (ns.insert H_uname)
    else
      reverse_dependencies_of_hyp_name_set_aux Hs revdeps ns

/--
`reverse_dependencies_of_hyp_name_set hs` is the list of reverse dependencies of
the hypotheses whose unique names appear in `hs`, excluding the `hs` themselves.
The reverse dependencies are returned in the order in which they appear in the
context.
-/
meta def reverse_dependencies_of_hyp_name_set (hs : name_set) :
  tactic (list expr) := do
  ctx ← local_context,
  let ctx := ctx.after (λ h, hs.contains h.local_uniq_name),
  reverse_dependencies_of_hyp_name_set_aux hs ctx [] hs

/--
`reverse_dependencies_of_hyp_set hs` is the list of reverse dependencies of the
hypotheses `hs`, excluding the `hs` themselves. The reverse dependencies are
returned in the order in which they appear in the context.
-/
meta def reverse_dependencies_of_hyp_set (hs : expr_set) : tactic (list expr) :=
reverse_dependencies_of_hyp_name_set $ local_set_to_name_set hs

/--
`reverse_dependencies_of_hyps hs` is the list of reverse dependencies of the
hypotheses `hs`, excluding the `hs` themselves. The reverse dependencies are
returned in the order in which they appear in the context.
-/
meta def reverse_dependencies_of_hyps (hs : list expr) : tactic (list expr) :=
reverse_dependencies_of_hyp_name_set $ local_list_to_name_set hs

private meta def reverse_dependencies_of_hyp_name_set_inclusive_aux :
  list expr → list expr → name_set → tactic (list expr)
| [] revdeps _ := pure revdeps.reverse
| (H :: Hs) revdeps ns := do
  let H_uname := H.local_uniq_name,
  H_is_revdep ← list.mbor
    [ pure $ ns.contains H.local_uniq_name,
      hyp_directly_depends_on_local_name_set H ns ],
  if H_is_revdep
    then
      reverse_dependencies_of_hyp_name_set_inclusive_aux Hs (H :: revdeps)
        (ns.insert H_uname)
    else
      reverse_dependencies_of_hyp_name_set_inclusive_aux Hs revdeps ns

/--
`reverse_dependencies_of_hyp_name_set_inclusive hs` is the list of reverse
dependencies of the hypotheses whose unique names appear in `hs`, including the
`hs` themselves. The reverse dependencies are returned in the order in which
they appear in the context.
-/
meta def reverse_dependencies_of_hyp_name_set_inclusive (hs : name_set) :
  tactic (list expr) := do
  ctx ← local_context,
  let ctx := ctx.drop_while (λ h, ¬ hs.contains h.local_uniq_name),
  reverse_dependencies_of_hyp_name_set_inclusive_aux ctx [] hs

/--
`reverse_dependencies_of_hyp_set_inclusive hs` is the list of reverse
dependencies of the hypotheses `hs`, including the `hs` themselves. The
inclusive reverse dependencies are returned in the order in which they appear in
the context.
-/
meta def reverse_dependencies_of_hyp_set_inclusive (hs : expr_set) :
  tactic (list expr) :=
reverse_dependencies_of_hyp_name_set_inclusive $ local_set_to_name_set hs

/--
`reverse_dependencies_of_hyps_inclusive hs` is the list of reverse dependencies
of the hypotheses `hs`, including the `hs` themselves. The reverse dependencies
are returned in the order in which they appear in the context.
-/
meta def reverse_dependencies_of_hyps_inclusive (hs : list expr) :
  tactic (list expr) :=
reverse_dependencies_of_hyp_name_set_inclusive $ local_list_to_name_set hs

/-! ### Reverting a hypothesis and its reverse dependencies -/

/--
`revert_name_set hs` reverts the hypotheses whose unique names appear in `hs`,
as well as any hypotheses that depend on them. Returns the number of reverted
hypotheses and a list containing these hypotheses. The reverted hypotheses are
returned in the order in which they used to appear in the context and are
guaranteed to store the correct type (see `tactic.update_type`).
-/
meta def revert_name_set (hs : name_set) : tactic (ℕ × list expr) := do
  to_revert ← reverse_dependencies_of_hyp_name_set_inclusive hs,
  to_revert_with_types ← to_revert.mmap update_type,
  num_reverted ← revert_lst to_revert,
  pure (num_reverted, to_revert_with_types)

/--
`revert_set hs` reverts the hypotheses `hs`, as well as any hypotheses that
depend on them. Returns the number of reverted hypotheses and a list containing
these hypotheses. The reverted hypotheses are returned in the order in which
they used to appear in the context and are guaranteed to store the correct type
(see `tactic.update_type`).
-/
meta def revert_set (hs : expr_set) : tactic (ℕ × list expr) :=
revert_name_set $ local_set_to_name_set hs

/--
`revert_lst' hs` reverts the hypotheses `hs`, as well as any hypotheses that
depend on them. Returns the number of reverted hypotheses and a list containing
these hypotheses. The reverted hypotheses are returned in the order in which
they used to appear in the context and are guaranteed to store the correct type
(see `tactic.update_type`).

This is a more informative version of `tactic.revert_lst`.
-/
meta def revert_lst' (hs : list expr) : tactic (ℕ × list expr) :=
revert_name_set $ local_list_to_name_set hs

/--
`revert_reverse_dependencies_of_hyp h` reverts all the hypotheses that depend on
the hypothesis `h`, including the local definitions that have `h` in their
value. This fixes a bug in `tactic.revert_kdependencies` that does not revert
local definitions for which `h` only appears in the value. Returns the number
of reverted hypotheses.
-/
/- We cannot implement it as `revert e >> intro1` because that would change the
local constant in the context. -/
meta def revert_reverse_dependencies_of_hyp (h : expr) : tactic ℕ :=
reverse_dependencies_of_hyp_name_set (mk_name_set.insert h.local_uniq_name) >>=
  revert_lst

/--
`revert_reverse_dependencies_of_hyp_name_set hs` reverts all the hypotheses that
depend on a hypothesis whose unique name appears in `hs`. The `hs` themselves
are not reverted, unless they depend on each other. Returns the number of
reverted hypotheses.
-/
meta def revert_reverse_dependencies_of_hyp_name_set (hs : name_set) : tactic ℕ :=
reverse_dependencies_of_hyp_name_set hs >>= revert_lst

/--
`revert_reverse_dependencies_of_hyp_set hs` reverts all the hypotheses that
depend on a hypothesis in `hs`. The `hs` themselves are not reverted, unless
they depend on each other. Returns the number of reverted hypotheses.
-/
meta def revert_reverse_dependencies_of_hyp_set (hs : expr_set) : tactic ℕ :=
reverse_dependencies_of_hyp_set hs >>= revert_lst

/--
`revert_reverse_dependencies_of_hyp hs` reverts all the hypotheses that depend
on a hypothesis in `hs`. The `hs` themselves are not reverted, unless they
depend on each other. Returns the number of reverted hypotheses.
-/
meta def revert_reverse_dependencies_of_hyps (hs : list expr) : tactic ℕ :=
reverse_dependencies_of_hyps hs >>= revert_lst

end tactic


import data.dlist

/- We want to write a set of tactics to automate the construction of
   instances. One approach might be to automate the specific instances
   that we are interested in. Instead, we will try to build reusable
   components and aim for wide applicability.

   Our first example of application is the construction of a `functor`
   instance for `(_ ⊕)`. We would like the instance to look like:

```
instance {α : Type*} : functor (sum α) :=
begin
  refineS { map := sum.map_right }, -- `refineS` focuses on structure fields
  field map_id
  { ... },
  field map_comp
  { ... },
end
```

   This structure is similar to the `cases / case id` syntax and we
   will use its underlying machinery to make our tactic work. We can
   identify two parts of the Lean API that we need to understand in
   order to make this work
     1. structure syntax and accessing field information
     2. using goal tagging

   Often, writing a new tactic involves using parts of the API that
   we're not fully familiar with so we're better get used to
   experimenting, making small prototypes to check if our
   understanding is correct. In the above example, we'd like to get
   the list of fields that are specified in the expression given to
   `refineS` and we'd like to know what are the fields that are
   missing in some sense. Let's start with the former.

   We set off to explore the core library and "grep" our way to useful
   functions:

```
library $ grep -R . -e structure
```

   The above is a miss: most of what we're getting is the list of
   structure declaration. What if we included underscores?

```
library $ grep -R . -e _structure
```

   It's a hit! We're getting
   https://github.com/leanprover/lean/blob/master/library/init/meta/pexpr.lean#L22-L31
   which looks promising. We reproduce the context below:

```
/-- Information about unelaborated structure instance expressions. -/
meta structure structure_instance_info :=
(struct       : option name := none)
(field_names  : list name)
(field_values : list pexpr)
(sources      : list pexpr := [])

/-- Create a structure instance expression. -/
meta constant pexpr.mk_structure_instance : structure_instance_info → pexpr
meta constant pexpr.get_structure_instance_info : pexpr → option structure_instance_info
```

Let's still try one more regex:

```
library $ grep -R . -e structure_
```

   We get more interesting stuff: https://github.com/leanprover/lean/blob/master/library/init/meta/environment.lean#L86-L87

```
/-- Return the fields of the structure with the given name, or `none` if it is not a structure -/
meta constant structure_fields : environment → name → option (list name)
```

   Let us see what `pexpr.get_structure_instance_info` tells us about `{ map := sum.map_right }`.
   We start by writing our tactic's type:
-/
open tactic

universes u v

example {α : Type u} : functor (sum α) :=
begin
  (do let e : pexpr := ``({ map := sum.map_right }),
      str ← e.get_structure_instance_info,
      trace str.field_names,
      trace str.field_values),
    -- prints:
    -- [map]
    -- [field_notation sum]
  admit
end

/- It's a success! It's important to see that `refineS₀` does no type
   checking on the expression we given it. This is why we get no error
   messages for `sum.map_right` not existing yet. `refineS₀`'s `e`
   argument is of type `parse texpr` which is definitionally equal to
   `pexpr`, the result of parsing an expression but doing no
   elaboration or type checking. In `parse texpr`, the type of `texpr`
   is `texpr : lean.parser pexpr` where `lean.parser` is the parsing
   monad.  Without going into details into `monads` as a programming
   construct or a mathematical object, objects of type `lean.parser α`
   are programs with access to the Lean parsing infrastructure
   including the current position of the parser and various parsing
   routines and the result of the program is of type `α`. Lean takes
   `parse texpr` as a hint that the tactic will be used interactively
   (as opposed to called by other tactics) and `texpr` is the parser
   to use to construct argument `e`. Other useful parsers can be found
   at https://github.com/leanprover/lean/blob/master/library/init/meta/interactive_base.lean#L69-L80.

   Our next experiment is to list the expected fields for the type
   that we are attempting to build. `environment.structure_fields`
   will help us in this:

```
meta constant structure_fields : environment → name → option (list name)
```

   What argument do we give it? Searching in `init/meta/tactic.lean`
   shows us that `get_env` will provide the first argument. The second
   argument is the type of the object that we're trying to build. More
   specifically, the name of that type.  If we call `target`, that
   type will be provided to us as an expression. In our case `functor
   (sum α)`. This expression contains multiple names. Which one do we
   want? Let us look at it closely by using `to_raw_fmt` to avoid any
   pretty printing and just get the syntax tree:

-/

example {α : Type u} : functor.{v} (sum α) :=
  -- (we use `.{v}` above so that Lean won't have to guess the universes which would
  -- create visual noise
begin
  (do let e : pexpr := ``({ map := sum.map_right }),
      tgt ← target,
      trace tgt.to_raw_fmt),
    -- prints:
    -- (app (const functor [v, max u v])
    --      (app (const sum [u, v])
    --           (local_const _ α (const 1 []))))
  admit
end

/- The printout shows us that our current type of interest is a
   function application whose function is `functor` and whose argument
   is another application. We don't actually care about any of the
   structure of the argument. The function is not always exactly what
   we care about either.  Consider for example `vector_space α β`. The
   function in the top-most application is `vector_space α` so we have
   to look at its function in order to land on `vector_space`
   itself. Does that mean that we have to look at the function of the
   function?  Let us consider a type class with the three arguments:
   `my_class α β γ`. The function of its function is `my_class α`. In
   short, we should keep retrieving functions until we run out of
   function applications. The result should be a constant and the name
   of that constant is what we need. If it is anything else than a
   constant, the user made a mistake and we will say no more of it
   here but various approaches can be taken for informative error
   messages.

   In `init/meta/expr.lean`, in the core library a function is
   provided to retrieve a function in a multi-argument function
   application: `expr.get_app_fn`.  It gives us another expression
   which we expect should be a constant. `expr.const_name` will reveal
   it's name.

-/
open nat
meta def mk_mvar_list : ℕ → tactic (list expr)
 | 0 := pure []
 | (succ n) := (::) <$> mk_mvar <*> mk_mvar_list n

open interactive interactive.types lean.parser
     tactic.interactive (itactic)

-- meta def tactic.interactive.refineS (e : parse texpr) : tactic unit :=
-- do    str ← e.get_structure_instance_info,
--       trace str.struct,
--       trace str.sources,
--       trace str.field_names,
--       tgt ← target,
--       let struct_n : name := tgt.get_app_fn.const_name,
--       env ← get_env,
--       exp_fields ← env.structure_fields struct_n,
--       let missing_f := (exp_fields.diff str.field_names).diff [`to_has_map],
--       vs ← mk_mvar_list missing_f.length,
--       let e' : pexpr := pexpr.mk_structure_instance
--           { -- struct := some struct_n
--           -- ,
--           field_names := str.field_names ++ missing_f
--           , field_values := str.field_values ++ vs.map to_pexpr },
--       refine ``(%%e' : %%tgt)

meta def var_names : expr → list name
 | (expr.pi n _ _ b) := n :: var_names b
 | _ := []

meta def drop_binders : expr → tactic expr
 | (expr.pi n bi t b) := b.instantiate_var <$> mk_local' n bi t >>= drop_binders
 | e := pure e

meta def subobject_names (struct_n : name) : tactic (list name × list name) :=
do env ← get_env,
   [c] ← pure $ env.constructors_of struct_n | fail "too many constructors",
   vs  ← var_names <$> (mk_const c >>= infer_type),
   fields ← env.structure_fields struct_n,
   return $ fields.partition (λ fn, ↑("_" ++ fn.to_string) ∈ vs)

def dlist.join {α} : list (dlist α) → dlist α
 | [] := dlist.empty
 | (x :: xs) := x ++ dlist.join xs

meta def expanded_field_list' : name → tactic (dlist $ name × name) | struct_n :=
do (so,fs) ← subobject_names struct_n,
   ts ← so.mmap (λ n, do
     e ← mk_const (n.update_prefix struct_n) >>= infer_type >>= drop_binders,
     expanded_field_list' $ e.get_app_fn.const_name),
   -- trace so, trace fs,
   return $ dlist.join ts ++ dlist.of_list (fs.map $ prod.mk struct_n)

meta def expanded_field_list (struct_n : name) : tactic (list $ name × name) :=
dlist.to_list <$> expanded_field_list' struct_n

def mmap₂ {α β γ} {m : Type u → Type v} [applicative m] (f : α → β → m γ) : list α → list β → m (list γ)
 | [] _ := pure []
 | _ [] := pure []
 | (x :: xs) (y :: ys) := (::) <$> f x y <*> mmap₂ xs ys

def mmap₂' {α β γ} {m : Type u → Type v} [applicative m] (f : α → β → m γ) : list α → list β → m punit
 | [] _ := pure punit.star
 | _ [] := pure punit.star
 | (x :: xs) (y :: ys) := f x y *> mmap₂' xs ys

def sum.map_right {α β β'} (f : β → β') : α ⊕ β → α ⊕ β'
 | (sum.inr x) := sum.inr $ f x
 | (sum.inl x) := sum.inl x

meta def tactic.interactive.refineS (e : parse texpr) (ph : parse $ optional $ tk "with" *> ident) : tactic unit :=
do    str ← e.get_structure_instance_info,
      tgt ← target,
      let struct_n : name := tgt.get_app_fn.const_name,
      exp_fields ← expanded_field_list struct_n,
      let exp_fields' := exp_fields.map prod.snd,
      let missing_f := exp_fields.filter (λ f, (f.2 : name) ∉ str.field_names),
      let provided := exp_fields.filter (λ f, (f.2 : name) ∈ str.field_names),
      vs ← mk_mvar_list missing_f.length,
      let e' : pexpr := pexpr.mk_structure_instance
          { struct := some struct_n
          , field_names := str.field_names ++ missing_f.map prod.snd
          , field_values := str.field_values ++ vs.map to_pexpr },
      refine e',
      gs ← with_enable_tags (
        mmap₂ (λ (n : name × name) v, do
           set_goals [v],
           try (interactive.unfold (provided.map $ λ ⟨s,f⟩, f.update_prefix s) (loc.ns [none])),
           apply_auto_param
             <|> apply_opt_param
             <|> (do match ph with
                       | (some ph) := () <$ (mk_const (n.2.update_prefix n.1) >>= pose ph none)
                       | none := return ()
                     end,
                     set_main_tag [`_field,n.2]),
           get_goals)
        missing_f vs),
      set_goals gs.join

meta def collect_tagged_goals (pre : name) : tactic (list expr) :=
do gs ← get_goals,
   gs.mfoldr (λ g r, do
      pre' :: t ← get_tag g,
      if t = [pre] ∧ pre' = pre'.get_prefix <.> "_field"
         then return (g::r)
         else return r)
      []

-- meta def match_field_tag

meta def tactic.interactive.field (tag : parse ident) (tac : itactic) : tactic unit :=
do ts ← collect_tagged_goals tag,
   match ts with
    | [] := fail format!"no field goal with tag {tag}"
    | [g] := do
      gs ← get_goals,
      set_goals $ g :: gs.filter (≠ g),
      solve1 tac
    | _ := fail format!"multiple goals have tag {tag}"
   end
universe w

instance {α : Type*} : functor (sum α) :=
  -- (we use `.{v}` above so that Lean won't have to guess the universes which would
  -- create visual noise
begin
  refineS { map := @sum.map_right _, .. } with law,
  all_goals { intros, casesm _ ⊕ _ ; refl },
end

structure except_t (f : Type u → Type v) (α : Type u) :=
 (run : f (string ⊕ α))

open has_map functor
def except_t.map {F} [functor F] {α β} (f : α → β) : except_t F α → except_t F β
 | ⟨ x ⟩ := ⟨ @has_map.map _ sum.functor.to_has_map _ _ f <$> x ⟩

lemma map_comp' {f : Type u → Type v} [functor f] {α β γ : Type u} (g : β → γ) (h : α → β) :
  map g ∘ map h = (map (g ∘ h) : f α → f γ) :=
by funext x ; rw [map_comp]

lemma map_id' {f : Type u → Type v} [functor f] {α} :
  (map id : f α → f α) = id :=
by funext x ; rw [id_map,id]

example {α : Type u} {f : Type u → Type w} [functor f] : functor (except_t f) :=
begin
  refineS { map := @except_t.map _ _ } with law
  ; intros ; casesm except_t f _ ; simp [except_t.map,map_id'],
  rw [← law,map_comp'],
end

example {α : Type u} : functor.{v} (sum α) :=
  -- (we use `.{v}` above so that Lean won't have to guess the universes which would
  -- create visual noise
begin
  (do let e : pexpr := ``({ map := sum.map_right }),
      tgt ← target,
      let struct_n : name := tgt.get_app_fn.const_name,
      trace struct_n,
        -- what are the fields of `functor`?
      env ← get_env,
      trace $ env.structure_fields struct_n),
    -- prints:
    -- functor
    -- (some [to_has_map, map_const_eq, id_map, map_comp])
  -- refine { map := sorry, .. },
  -- refineS { map := sorry },
  -- (do fs ← expanded_field_list `applicative,
  --     trace fs ),
  refineS { map := @sum.map_right _, .. } with field,
  -- field map_const_eq { dunfold has_map.map, tactic.apply_auto_param },
  field map_comp { intros, casesm _ ⊕ _ ; refl },
  field id_map { intros, casesm _ ⊕ _ ; refl },
  -- trace_result
  -- (do let e : pexpr := ``({ map := @sum.map_right _ }),
  --     str ← e.get_structure_instance_info,
  --     tgt ← target,
  --     let struct_n : name := tgt.get_app_fn.const_name,
  --     exp_fields ← expanded_field_list struct_n,
  --     let missing_f := exp_fields.diff str.field_names,
  --     vs ← mk_mvar_list missing_f.length,
  --     trace str.field_values,
  --     trace str.field_names,
  --     trace missing_f,
  --     let e' : pexpr := pexpr.mk_structure_instance
  --         { struct := some struct_n
  --         , field_names := str.field_names ++ missing_f
  --         , field_values := str.field_values ++ vs.map to_pexpr },
  --     trace e',
  --     refine e'),
  -- admit,
end