/-*
---
title: Making Illegal States Unrepresentable
---

<!-- .slide: class="center" -->

# Making Illegal States Unrepresentable

## Dependent Types And Why They're Useful

---

<!-- .slide: class="center" -->

# Prologue: Why Types?

----

Types serve two major purposes:

- Abstraction - humans need to understand code.
- Static code analysis - computers need to understand code, too.

----

## Abstraction

Types let us make code "about" useful concepts like dates, users, and files.
We're no longer restricted to thinking about a single kind of data, such as bytes.

Types define which values and operations are valid in a given context.
We can write code "about" sending an email or opening a file.

In the words of Yaron Minsky, we can use types to
[make illegal states unrepresentable](https://blog.janestreet.com/effective-ml-revisited/).
The simplest example is a yes/no flag.
When all we have are bytes, there are 256 possible states, but we only want there to be two (yes and no).
There will be 254 illegal or redundant states.

A boolean type solves this problem by having only two possible states, by definition.

This approach is fantastically useful in making code more robust without needing to write a lot of error checking.
The definitions of types can avoid giving us ways to make mistakes.

----

## Static analysis

The most directly useful way to use types is to allow the compiler to check our code for certain kinds of errors.

```csharp
DateTime MyFunction(int a, string b)
{
    return a / b;
}
```

This code is syntactically correct, but obvious nonsense.
You can't divide a number by a string, especially not in a way that produces a date/time.

In order to understand what went wrong, we need the concept of types.
And once we have a compiler that understands types,
it can check code automatically to make sure it follows the rules of types.

---

<!-- .slide: class="center" -->

# Chapter 1: Simple types

----

We'll be using Lean from here on. Lean is a functional programming language with dependent types.

Let's start writing some code.
*-/

-- Ignore the default math notation and stick to ASCII.
set_option pp.unicode false

/-*
----

In Lean, every expression has a type. Let's check the types of a few expressions.
*-/

#check 1 + 1
-- 1 + 1 : nat

#check "Hello, World!"
-- "Hello, World!" : string

#check int
-- int : Type

/-*
`1 + 1` is a `nat`, that is, a natural number (nonnegative integer). `"Hello, World!"` is a string, and `int` is a type.

You may notice that the syntax for `int` is the same as the other values.
Lean has first-class types, meaning that types can be assigned to variables and passed to functions,
just like data.

----

## Creating new types

Most languages come with a few ways to define new complex types from simpler types.

Here are several useful kinds of complex types.
*-/

namespace simple

/-*
----

## Functions

In functional programming, functions are values, and therefore they have types.

Let's declare a variable that contains the type of functions that accept a string and return an integer,
using the `->` notation.
*-/

def my_function_type := string -> int

#check my_function_type
-- my_function_type : Type

/-*
This is indeed a type.

----

We can create a value of this type by defining a function.
*-/

def my_function : my_function_type := fun s, s.length

#check my_function
-- my_function : my_function_type

#check my_function "Hello, World!"
-- my_function "Hello, World!" : int

#eval my_function "Hello, World!"
-- 13

/-*
If we apply the function to a string, it will return an `int`.
If we apply it to `"Hello, World!"`, it will return 13, since that is the length of the string.

----

## Records

To store multiple related pieces of data together, we use record types (or structures).

Let's define a type for a person with a name and an age, using the `structure` keyword.
*-/

structure person := (name : string) (age : nat)

#check person
-- person : Type

/-*
Once again, we have a type.

----

Unsurprisingly, we can create a value of this type:
*-/

def kendall : person := { name := "Kendall", age := 42 }

#check kendall
-- kendall : person

#check kendall.name
-- kendall.name : string

#eval kendall.name
-- "Kendall"

/-*
Record types are very common in modern programming.
Objects are based on records, and so all object-oriented languages implicitly use the concept of records.

----

## Unions

To store one of multiple possible types of values, we use union types (or sum types).

Lean doesn't support union type definitions directly like it does records.
It does have a `sum` type, which is a built-in type that represents a union of two types.
*-/

def int_or_string := sum int string

#check int_or_string
-- int_or_string : Type

/-*
----

Once again, we can create a value of this type.
`sum.inl` is the way to create a value of the "left" side of a sum.
*-/

def forty_two : int_or_string := sum.inl 42

#check forty_two
-- forty_two : int_or_string

/-*
----

## Inductive Types

Inductive type definitions are a combination of records and unions.
They are very powerful and used in many languages.

Inductive types have zero or more constructors. Each constructor takes zero or more parameters.

----

An **enum** can be implemented as an inductive type where none of the constructors take parameters:
*-/

inductive boolean
| true
| false

#check boolean
-- boolean : Type

#check boolean.true
-- boolean.true : boolean

/-*
----

A **union** can be implemented as an inductive type where each constructor takes one parameter:
*-/

inductive int_or_string2
| from_int (n : int)
| from_string (s : string)

#check int_or_string2
-- int_or_string2 : Type

#check int_or_string2.from_int
-- int_or_string2.from_int : int -> int_or_string2

def forty_three := int_or_string2.from_int 43

#check forty_three
-- forty_three : int_or_string2

/-*
Constructors that take parameters are functions.

----

A **record** can be implemented as an inductive type with only one constructor:
*-/

inductive vector
| make (x : int) (y : int)

#check vector.make
-- vector.make : int -> int -> vector

def origin := vector.make 0 0

#check origin
-- origin : vector

/-*
----

Inductive types can also be more complex. Here is how a list of natural numbers is defined, using recursion:
*-/

inductive list
| empty
| make (head : nat) (tail : list)

#check list.empty
-- list.empty : list

#check list.make
-- list.make : nat -> list -> list

#check list.make 42 list.empty
-- list.make 42 list.empty : list

/-*
This reads as: A list of nats is either the empty list or a nat (the first one in the list)
plus a list of nats (the rest of the list).

----

Inductive types are the main way to create types in many functional programming languages,
just like classes are in many object-oriented languages.

This includes types like lists or arrays, which don't need to be built into the compiler but can be defined in code.
*-/

end simple

/-*
---

<!-- .slide: class="center" -->

# Chapter 2: Generic types

----

There's a problem with the simple type system we've seen so far.
We defined a type that can represent a list of nats, but what if we want a list of ints, or a list of strings?
It wouldn't be good to repeat the same definition over and over for each possible type.

Generic types solve this problem.
They let us pass types as parameters, so we can create a version of the generic type for any type we wish.
*-/

namespace generic

/-*
----

## Inductive types

Here's what a list looks like as a generic type:
*-/

inductive list (a : Type)
| empty : list
| make (head : a) (tail : list) : list

#check list
-- list : Type -> Type

#check list string
-- list string : Type

/-*
Here `list` takes a parameter `a` which is the type of elements in the list.

A generic type is a function that accepts a type and returns a type.

----

## Function types

It's possible to define generic function types as well.
*-/

def serializer (a : Type) := a -> string

#check serializer
-- serializer : Type -> Type

#check serializer nat
-- serializer nat : Type

/-*
A `serializer a` is a function that converts an `a` to a string.

----
*-/

def my_serializer : serializer nat := fun x, to_string x

#check my_serializer
-- my_serializer : serializer nat

#check my_serializer 42
-- my_serializer 42 : string

#eval my_serializer 42
-- "42"

/-*
Passing a nat to a nat serializer results in a string.

----

## Records

Records can also be generic.
*-/

structure vector (a : Type) := (x : a) (y : a)

#check vector
-- vector : Type -> Type

#check vector int
-- vector int : Type

/-*
This is a vector that can store two coordinates of any type.

----

Even strings, if we wish.
*-/

def not_origin : vector string := { x := "0", y := "Hello, World!" }

#check not_origin
-- not_origin : vector string

#check not_origin.y
-- not_origin.y : string

#eval not_origin.y
-- "Hello, World!"

/-*
----

Generic types are supported by many popular languages. They're extremely helpful in writing reusable code.
*-/

end generic

/-*
---

<!-- .slide: class="center" -->

# Chapter 3 : Generalized Algebraic Data Types

----

Let's briefly look at generalized algebraic data types, or GADTs for short.
GADTs are generic inductive types where different constructors return different types.
*-/

namespace gadt

/-*
----

If we were writing a parser for some language, one of the types we might want is a type for literal expressions.
*-/

-- These are placeholder definitions
constant float : Type
constant regex : Type
constant date : Type

inductive literal : Type -> Type
| numeric (n : float) : literal float -- e.g. 3.14
| string (s : string) : literal string -- e.g. "Hello, World!"
| regex (r : regex) : literal regex -- e.g. /.+@.+\..+/
| date (d : date) : literal date -- e.g. #2000-01-01#

#check literal
-- literal : Type -> Type

/-*
Instead of having four different types for each kind of literal,
we can have a single type that can represent any literal expression.

----

`literal` does not restrict what types you can pass to it.
*-/

-- This is cool, we defined a constructor for this.
#check literal string
-- literal string : Type

-- We didn't define a constructor for this.
#check literal (list int)
-- literal (list int) : Type

/-*
Even though `literal (list int)` is a real type, it has no constructors. There is no way to create a value of that type.
Every literal expression is one of only four kinds.

----

GADTs let us restrict the kinds of values a type can have.
This is necessary for some more advanced types, as we'll soon see.
*-/

end gadt

/-*
---

<!-- .slide: class="center" -->

# Chapter 4: Dependent Types

----

Generic types are constructed from other types. However, we can also define types that are constructed from values.
These are called dependent types.
*-/

namespace dependent

/-*
----

## Dependent Inductive Types

The classic example of a dependent type is a vector. A vector is like a list with a fixed length.
*-/

inductive vector (a : Type) : nat -> Type
| empty : vector 0
| make {n : nat} (head : a) (tail : vector n) : vector (n + 1)

#check vector
-- vector : Type -> nat -> Type

#check vector int 5
-- vector int 5 : Type

/-*
Like a generic type, `vector` is a function returning a type.

A `vector int 5` is a list of exactly 5 ints.

----
*-/

#check vector.make 42 vector.empty
-- vector.make 42 vector.empty : vector nat (0 + 1)

/-*
By adding an item to the empty vector (length 0), we get a vector of length 0 + 1.

`vector` is a GADT. The only way to make a 0-vector is with `vector.empty`,
and the only way to make an n+1-vector is by adding a value to an n-vector with `vector.make`.

----

## Dependent Records
*-/

structure n_vector := (n : nat) (vec : vector int n)

#check n_vector
-- n_vector : Type

/-*
This is a type consisting of a nat and a vector of that length.
This turns out to be equivalent to a list, but this time the length is stored as part of the data structure.

----

## Dependent Functions
*-/

def vector_builder := forall (n : nat), vector int n

#check vector_builder
-- vector_builder : Type

/-*
`forall` is the way to write dependent function types, much like `->` is used for ordinary function types.

This is a type representing functions that accept a nat and return a vector of that length.

----
*-/

def origin : vector_builder
| 0 := vector.empty
| (n + 1) := vector.make 0 (origin n)

#check origin
-- origin : vector_builder

#check origin 3
-- origin 3 : vector int 3

/-*
This function returns the zero vector for any given number of dimensions.
For example, `origin 3` is the vector (0, 0, 0).

----

Dependent types are an even more powerful than generic types, and can be used to make some very specific types.
*-/

end dependent

/-*
---

<!-- .slide: class="center" -->

# Chapter 5 : Propositions

----

Propositions are statements of fact that have a truth value. 1 + 1 = 2 is true, and 2 + 2 = 1 is false.
We can write propositions about our code that let us reason about its behaviour.
*-/

#check 1 + 1 = 2
-- 1 + 1 = 2 : Prop

#check 10 > 100
-- 10 > 100 : Prop

/-*
This looks a lot like a boolean. The problem with booleans is that they don't carry any information.

As it turns out, we can implement propositions as dependent types.
Values of those types are evidence (or proofs). They carry information about *why* the proposition is true.
A false proposition has no evidence, and so its type has no values.
*-/

namespace proposition

/-*
----

We can define propositions in the same way we define types, but by using `Prop` instead of `Type`.
*-/

inductive even : nat -> Prop
| zero : even 0
| plus_two {n : nat} (h : even n) : even (n + 2)

/-*
This defines what it means for a natural number to be even, by defining what kind of evidence is possible.
`even.zero` is evidence that 0 is even.
`even.plus_two` takes evidence that `n` is even and produces evidence that `n + 2` is even.

----
*-/

#check even 1
-- even 1 : Prop

def even_2 := even.plus_two even.zero

#check even_2
-- even_2 : even (0 + 2)

/-*
`even_2` is a value of type `even 2`. It's evidence that 2 is even.

There is no way to construct a value of type `even 1`. There can never be evidence that 1 is even.

----

The is how to define the proposition that a list contains some value.
*-/

inductive contains {a : Type} : a -> generic.list a -> Prop
| head (x : a) (xs : generic.list a) : contains x (generic.list.make x xs)
| tail (x : a) (y : a) (xs : generic.list a) (h : contains x xs)
  : contains x (generic.list.make y xs)

/-*
`contains.head` is evidence that a list beginning with some value contains that value.
`contains.tail` takes evidence that a list contains some value,
and produces evidence that a bigger list made from that list contains the same value.

There is no value of type `contains x list.empty`. There can never be evidence that the empty list contains any value.

----
*-/

#check contains 5
-- contains 5 : generic.list nat -> Prop

#check contains "Hello" generic.list.empty
-- contains "Hello" generic.list.empty : Prop

/-*
`contains x` is a function that accepts a list and returns a proposition (whether the list contains `x`).

----

Probably the most useful kind of proposition is equality.
*-/

inductive equals {a : Type} : a -> a -> Prop
| reflexive (x : a) : equals x x

#check equals.reflexive 42
-- equals.reflexive 42 : equals 42 42

/-*
This is pretty much how the `=` operator is implemented in Lean.
The only kind of evidence that `a = b` is by having `a` and `b` be the same thing.
If they weren't the same thing, they wouldn't be equal.

----

Proposition types let us store evidence for facts about our data,
which makes it possible to guarantee certain requirements at compile time.
*-/

end proposition

/-*
---

<!-- .slide: class="center" -->

# Chapter 6: Making Illegal States Unrepresentable

----

One way we can make it easier to write bug-free code is to make it impossible to create invalid data.
Something simple like using unsigned integers for values that are not allowed to be negative can prevent bugs.

Most of the time it's possible to create types where every possible value is meaningful and valid,
avoiding the need to write code checking for invalid values.
*-/

namespace making_illegal_states_unrepresentable

/-*
----

Most programmers know about `NullReferenceException`, `NullPointerException`,
or some such error caused by that infamous value, null.
Tony Hoare called the invention of null references his
["billion dollar mistake"](https://www.youtube.com/watch?v=YYkOWzrO3xg).

In Lean and many other functional languages, there is no concept of null.
If you want an optional value, you must explicitly say so at compile time, using the generic `option` type.
*-/

inductive option (a : Type)
| none : option
| some (x : a) : option

/-*
Values of an `option` type are either `some` value, or `none`.
*-/

def optional_int_1 : option int := option.some 42
def optional_int_2 : option int := option.none

/-*
Importantly, `option` variables cannot be used as if they are non-optional variables,
like nullable variables can in many languages.

----

Another common problem is `IndexOutOfRangeException` or `IndexOutOfBoundsException`,
caused by using a number which isn't a valid index into a list.
We can solve this with the `fin` dependent type, allowing us to restrict a number to a finite bound.
*-/

structure fin (n : nat) := (x : nat) (h : x < n)

/-*
`fin 5` is the type representing numbers less than five, that is, zero through four.
It's impossible to represent a number five or greater,
because every number comes with evidence that it is less than five.

This can be used to make an indexer function that has compile-time bounds checking.
*-/

constant element_at {a : Type} (l : list a) (i : fin l.length) : a

/-*
A function with this type accepts a list and a number less than the length of the list, which is always a valid index.
Unfortunately, most of the time evidence like this must be created manually,
because the compiler isn't always smart enough to create it automatically.

----

Here are more examples of problems that could be caught at compile time by using dependent types and/or propositions:

- Trying to get the first item of an empty list - require evidence that the list's length is greater than zero.
- Division by zero - require evidence that the denominator is not equal to zero.
- Binary search on an unsorted list - require evidence that the list is sorted.
- Passing the wrong number or wrong type of arguments to a string formatting function
(e.g. `string.Format` or `sprintf`) -
use a dependent function to make the function require the correct arguments based on the format string.
Brian McKenna has [a demonstration](https://www.youtube.com/watch?v=fVBck2Zngjo).
*-/

end making_illegal_states_unrepresentable

/-*
---

<!-- .slide: class="center" -->

# Epilogue: So What?

----

I'm not trying to tell you that dependent types are the solution to all your problems.
I'm not even trying to tell you to learn a dependently typed language.

I just want you to be aware of some of the patterns that exist to make code more reliable using a good type system.

Strong typing is your friend. Use it. Your compiler might not thank you, but your future self will.

----

If you're interested in learning more about type systems or dependent types, I have some suggestions.

- If you want to learn functional programming and some of the simpler concepts I showed,
[Haskell](https://www.haskell.org/) is very good at this.
- If you want to try writing programs using dependent types, [Idris](https://www.idris-lang.org/) is a practical option.
It's very similar to Haskell, but with dependent types.
- If you want to learn more about type theory and how mathematicians use dependent types to write and verify
mathematical proofs, I suggest trying [Lean](https://leanprover.github.io/), the language I've been using throughout.

----

If you want to try the code samples for yourself, the source code for this slideshow is at
https://github.com/kendfrey/making-illegal-states-unrepresentable/blob/master/src/index.lean.

---

<!-- .slide: class="center" -->

# Thank You
*-/


import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open_cover A),
  have h1 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h2 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h3 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h4 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h5 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h6 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h7 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h8 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
end

/--`theorem`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


-- Copyright 2022-2023 VMware, Inc.
-- SPDX-License-Identifier: BSD-2-Clause

import .incremental
import .relational
import .relational_incremental

open zset

class schema :=
  -- the schemas for the two tables, T and R
  (T R : Type)
  -- t.a > 2
  -- r.s > 5
  (σT : T → Prop) (σR : R → Prop)
  -- the type of t1.x, t2.y, and the common id field
  (T1X T2Y Id : Type)
  (π1 : T → T1X × Id) (π2 : R → Id × T2Y).

def πxy (S: schema) (t : (S.T1X × S.Id) × (S.Id × S.T2Y)) : S.T1X × S.T2Y :=
  (t.1.1, t.2.2).

class schema_ok (S: schema) :=
  (i1 : decidable_eq S.T)
  (i2 : decidable_eq S.R)
  (i3 : decidable_pred S.σT)
  (i4 : decidable_pred S.σR)
  (i5 : decidable_eq S.T1X)
  (i6 : decidable_eq S.T2Y)
  (i7 : decidable_eq S.Id).

section instances.
open schema_ok.
attribute [instance] i1 i2 i3 i4 i5 i6 i7.
end instances.

variables (S: schema) [schema_ok S].

def t1 : Z[S.T] → Z[S.T1X × S.Id] :=
  λ t, zset.distinct (zset.map S.π1 (zset.distinct (filter S.σT (zset.distinct t)))).

def t2 : Z[S.R] → Z[S.Id × S.T2Y] :=
  λ r, zset.distinct (zset.map S.π2 (zset.distinct (filter S.σR (zset.distinct r)))).

def V : Z[S.T] → Z[S.R] → Z[S.T1X × S.T2Y] :=
  λ t r, zset.distinct
    (zset.map (πxy S)
      (equi_join prod.snd prod.fst (t1 S t) (t2 S r))).

-- set up optimizations

/- pos_equiv says f1 and f2 are equivalent on positive inputs -/
def pos_equiv {A B: Type} [decidable_eq A] [decidable_eq B]
  (f1 f2: Z[A] → Z[B]) :=
  ∀ i, is_bag i → f1 i = f2 i.

def pos_equiv2 {A B C: Type} [decidable_eq A] [decidable_eq B] [decidable_eq C]
  (f1 f2: Z[A] → Z[B] → Z[C]) :=
  ∀ i1 i2, is_bag i1 → is_bag i2 → f1 i1 i2 = f2 i1 i2.

infix ` =≤= `:50 := pos_equiv.
infix ` =≤2= `:50 := pos_equiv2.

/-- `same` is a technical device for automation purposes. It is just equality,
  but marked irreducible.

  The way this is used is that we can work on a goal `same x ?y` (where `?y` is
  an existential variable), gradually rewriting x to simplify it. If we tried to
  prove `x = ?y`, then `rw` an `simp` would always try to instantiate ?y with x,
  even if we want to continue rewriting.

  To make intermediate goals readable we provide `x === y` as notation for `same
  x y`.
   -/
def same {A : Type} (x y: A) := x = y.
lemma same_def {A} (x y: A) : same x y = (x = y) := rfl.
local attribute [irreducible] same.

lemma same_intro {A: Type} (x y: A) : same x y → x = y :=
  by { rw same_def, finish, }.

lemma same_elim {A: Type} (x: A) : same x x :=
  by { rw same_def, }.

infix ` === `:50 := same.

structure sig (A: Type) (p: A → Prop) :=
  (witness: A)
  (pf: p witness).

def t1_opt_goal : sig (Z[S.T] → Z[S.T1X × S.Id])
                  (λ opt, t1 S =≤= opt) :=
begin
  econstructor,
  intros t hpos,
  apply same_intro,
  simp [t1],
  rw filter_distinct_dedup,
  rw map_distinct_dedup,
  swap, { apply filter_pos, assumption, },
  apply same_elim,
end

-- TODO: reduce this first
def t1_opt := (t1_opt_goal S).witness.
def t1_opt_ok : t1 S =≤= t1_opt S := (t1_opt_goal S).pf.

def t2_opt_goal : sig (Z[S.R] → Z[S.Id × S.T2Y])
                  (λ opt, t2 S =≤= opt) :=
begin
  econstructor,
  intros t hpos,
  apply same_intro,
  simp [t2],
  rw filter_distinct_dedup,
  rw map_distinct_dedup,
  swap, { apply filter_pos, assumption, },
  apply same_elim,
end

def v_opt_goal : sig (Z[S.T] → Z[S.R] → Z[S.T1X × S.T2Y])
                  (λ opt, V S =≤2= opt) :=
begin
  econstructor, intros i1 i2 hpos1 hpos2,
  apply same_intro,
  simp [V],
  rw (t1_opt_goal S).pf _ (by assumption),
  rw (t2_opt_goal S).pf _ (by assumption),
  simp [t1_opt_goal, t2_opt_goal],
  rw join_distinct_comm, rotate,
  { apply map_pos, apply filter_pos, assumption, },
  { apply map_pos, apply filter_pos, assumption, },
  rw map_distinct_dedup, rotate,
  { apply equi_join_pos; apply map_pos; apply filter_pos; assumption },
  apply same_elim,
end

/- The optimized ℤ-set query from the paper -/
def Vopt (t1: Z[S.T]) (t2: Z[S.R]) :=
  distinct $ zset.map (πxy S)
    (equi_join prod.snd prod.fst
      (zset.map schema.π1 (filter schema.σT t1))
      (zset.map schema.π2 (filter schema.σR t2))).

-- the simplifications above produce exactly what's in the paper
lemma v_opt_ok : V S =≤2= Vopt S :=
  (v_opt_goal S).pf.

lemma v_lifted : ↑²(Vopt S) =
  λ t1 t2, ↑↑distinct (↑↑(zset.map (πxy S)) (↑²(equi_join prod.snd prod.fst)
      (↑↑(zset.map schema.π1) (↑↑(filter schema.σT) t1))
      (↑↑(zset.map schema.π2) (↑↑(filter schema.σR) t2)))) :=
begin
  refl,
end

/- This is the intermediate incremental circuit -/
def VΔ1 (t1: stream Z[S.T]) (t2: stream Z[S.R]) :=
  (↑↑distinct)^Δ $ ↑↑(zset.map (πxy S)) $ ↑²(equi_join prod.snd prod.fst)^Δ2
      (↑↑(zset.map schema.π1) (↑↑(filter schema.σT) t1))
      (↑↑(zset.map schema.π2) (↑↑(filter schema.σR) t2)).

lemma VΔ1_ok :
  ↑²(Vopt S)^Δ2 = VΔ1 S :=
begin
  funext t1 t2,
  -- hide the right-hand side
  transitivity,
  { apply same_intro,
    rw v_lifted, dsimp,
    dsimp only [incremental2],
    repeat { rw D_push2 <|> rw D_push }, simp,
    -- TODO: why does this have to be done explicitly?
    rw (map_incremental (πxy S)),
    rw (map_incremental schema.π1), simp,
    rw (map_incremental schema.π2), simp,
    apply same_elim, },
  { refl },
end

def VΔ (t1: stream Z[S.T]) (t2: stream Z[S.R]) :=
  distinct_incremental $ ↑↑(zset.map $ πxy S) $ times_incremental ↑²(equi_join prod.snd prod.fst)
      (↑↑(zset.map schema.π1) (↑↑(filter schema.σT) t1))
      (↑↑(zset.map schema.π2) (↑↑(filter schema.σR) t2)).

theorem VΔ_ok :
  ↑²(Vopt S)^Δ2 = VΔ S :=
begin
  rw VΔ1_ok, funext t1 t2, unfold VΔ1,
  rw distinct_incremental_ok,
  rw equi_join_incremental,
  refl,
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Jacob von Raumer
-/
import Lean.Elab.Tactic.Induction

/-!

# Recursive cases (`rcases`) tactic and related tactics

`rcases` is a tactic that will perform `cases` recursively, according to a pattern. It is used to
destructure hypotheses or expressions composed of inductive types like `h1 : a ∧ b ∧ c ∨ d` or
`h2 : ∃ x y, trans_rel R x y`. Usual usage might be `rcases h1 with ⟨ha, hb, hc⟩ | hd` or
`rcases h2 with ⟨x, y, _ | ⟨z, hxz, hzy⟩⟩` for these examples.

Each element of an `rcases` pattern is matched against a particular local hypothesis (most of which
are generated during the execution of `rcases` and represent individual elements destructured from
the input expression). An `rcases` pattern has the following grammar:

* A name like `x`, which names the active hypothesis as `x`.
* A blank `_`, which does nothing (letting the automatic naming system used by `cases` name the
  hypothesis).
* A hyphen `-`, which clears the active hypothesis and any dependents.
* The keyword `rfl`, which expects the hypothesis to be `h : a = b`, and calls `subst` on the
  hypothesis (which has the effect of replacing `b` with `a` everywhere or vice versa).
* A type ascription `p : ty`, which sets the type of the hypothesis to `ty` and then matches it
  against `p`. (Of course, `ty` must unify with the actual type of `h` for this to work.)
* A tuple pattern `⟨p1, p2, p3⟩`, which matches a constructor with many arguments, or a series
  of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`,
  then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b`
  and so on.
* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor,
  while leaving the `@` off will only use the patterns on the explicit arguments.
* An alternation pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors,
  or a nested disjunction like `a ∨ b ∨ c`.

The patterns are fairly liberal about the exact shape of the constructors, and will insert
additional alternation branches and tuple arguments if there are not enough arguments provided, and
reuse the tail for further matches if there are too many arguments provided to alternation and
tuple patterns.

This file also contains the `obtain` and `rintro` tactics, which use the same syntax of `rcases`
patterns but with a slightly different use case:

* `rintro` (or `rintros`) is used like `rintro x ⟨y, z⟩` and is the same as `intros` followed by
  `rcases` on the newly introduced arguments.
* `obtain` is the same as `rcases` but with a syntax styled after `have` rather than `cases`.
  `obtain ⟨hx, hy⟩ | hz := foo` is equivalent to `rcases foo with ⟨hx, hy⟩ | hz`. Unlike `rcases`,
  `obtain` also allows one to omit `:= foo`, although a type must be provided in this case,
  as in `obtain ⟨hx, hy⟩ | hz : a ∧ b ∨ c`, in which case it produces a subgoal for proving
  `a ∧ b ∨ c` in addition to the subgoals `hx : a, hy : b |- goal` and `hz : c |- goal`.

## Tags

rcases, rintro, obtain, destructuring, cases, pattern matching, match
-/

/--
Constructs a substitution consisting of `s` followed by `t`.
This satisfies `(s.append t).apply e = t.apply (s.apply e)`
-/
def Lean.Meta.FVarSubst.append (s t : FVarSubst) : FVarSubst :=
  s.1.foldl (fun s' k v => s'.insert k (t.apply v)) t

namespace Std.Tactic.RCases
open Lean Meta

/-- The syntax category of `rcases` patterns. -/
declare_syntax_cat rcasesPat
/-- A medium precedence `rcases` pattern is a list of `rcasesPat` separated by `|` -/
syntax rcasesPatMed := sepBy1(rcasesPat, " | ")
/-- A low precedence `rcases` pattern is a `rcasesPatMed` optionally followed by `: ty` -/
syntax rcasesPatLo := rcasesPatMed (" : " term)?
/-- `x` is a pattern which binds `x` -/
syntax (name := rcasesPat.one) ident : rcasesPat
/-- `_` is a pattern which ignores the value and gives it an inaccessible name -/
syntax (name := rcasesPat.ignore) "_" : rcasesPat
/-- `-` is a pattern which removes the value from the context -/
syntax (name := rcasesPat.clear) "-" : rcasesPat
/--
A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor,
while leaving the `@` off will only use the patterns on the explicit arguments.
-/
syntax (name := rcasesPat.explicit) "@" rcasesPat : rcasesPat
/--
`⟨pat, ...⟩` is a pattern which matches on a tuple-like constructor
or multi-argument inductive constructor
-/
syntax (name := rcasesPat.tuple) "⟨" rcasesPatLo,* "⟩" : rcasesPat
/-- `(pat)` is a pattern which resets the precedence to low -/
syntax (name := rcasesPat.paren) "(" rcasesPatLo ")" : rcasesPat

/-- The syntax category of `rintro` patterns. -/
declare_syntax_cat rintroPat
/-- An `rcases` pattern is an `rintro` pattern -/
syntax (name := rintroPat.one) rcasesPat : rintroPat
/--
A multi argument binder `(pat1 pat2 : ty)` binds a list of patterns and gives them all type `ty`.
-/
syntax(name := rintroPat.binder) (priority := default+1) -- to override rcasesPat.paren
  "(" rintroPat+ (" : " term)? ")" : rintroPat

instance : Coe Ident (TSyntax `rcasesPat) where
  coe stx := Unhygienic.run `(rcasesPat| $stx:ident)
instance : Coe (TSyntax `rcasesPat) (TSyntax ``rcasesPatMed) where
  coe stx := Unhygienic.run `(rcasesPatMed| $stx:rcasesPat)
instance : Coe (TSyntax ``rcasesPatMed) (TSyntax ``rcasesPatLo) where
  coe stx := Unhygienic.run `(rcasesPatLo| $stx:rcasesPatMed)
instance : Coe (TSyntax `rcasesPat) (TSyntax `rintroPat) where
  coe stx := Unhygienic.run `(rintroPat| $stx:rcasesPat)

/-- A list, with a disjunctive meaning (like a list of inductive constructors, or subgoals) -/
local notation "ListΣ" => List

/-- A list, with a conjunctive meaning (like a list of constructor arguments, or hypotheses) -/
local notation "ListΠ" => List

/--
An `rcases` pattern can be one of the following, in a nested combination:

* A name like `foo`
* The special keyword `rfl` (for pattern matching on equality using `subst`)
* A hyphen `-`, which clears the active hypothesis and any dependents.
* A type ascription like `pat : ty` (parentheses are optional)
* A tuple constructor like `⟨p1, p2, p3⟩`
* An alternation / variant pattern `p1 | p2 | p3`

Parentheses can be used for grouping; alternation is higher precedence than type ascription, so
`p1 | p2 | p3 : ty` means `(p1 | p2 | p3) : ty`.

N-ary alternations are treated as a group, so `p1 | p2 | p3` is not the same as `p1 | (p2 | p3)`,
and similarly for tuples. However, note that an n-ary alternation or tuple can match an n-ary
conjunction or disjunction, because if the number of patterns exceeds the number of constructors in
the type being destructed, the extra patterns will match on the last element, meaning that
`p1 | p2 | p3` will act like `p1 | (p2 | p3)` when matching `a1 ∨ a2 ∨ a3`. If matching against a
type with 3 constructors,  `p1 | (p2 | p3)` will act like `p1 | (p2 | p3) | _` instead.
-/
inductive RCasesPatt : Type
  /-- A parenthesized expression, used for hovers -/
  | paren (ref : Syntax) : RCasesPatt → RCasesPatt
  /-- A named pattern like `foo` -/
  | one (ref : Syntax) : Name → RCasesPatt
  /-- A hyphen `-`, which clears the active hypothesis and any dependents. -/
  | clear (ref : Syntax) : RCasesPatt
  /-- An explicit pattern `@pat`. -/
  | explicit (ref : Syntax) : RCasesPatt → RCasesPatt
  /-- A type ascription like `pat : ty` (parentheses are optional) -/
  | typed (ref : Syntax) : RCasesPatt → Term → RCasesPatt
  /-- A tuple constructor like `⟨p1, p2, p3⟩` -/
  | tuple (ref : Syntax) : ListΠ RCasesPatt → RCasesPatt
  /-- An alternation / variant pattern `p1 | p2 | p3` -/
  | alts (ref : Syntax) : ListΣ RCasesPatt → RCasesPatt
  deriving Repr

namespace RCasesPatt

instance : Inhabited RCasesPatt := ⟨RCasesPatt.one Syntax.missing `_⟩

/-- Get the name from a pattern, if provided -/
partial def name? : RCasesPatt → Option Name
  | one _ `_    => none
  | one _ `rfl  => none
  | one _ n     => n
  | paren _ p
  | typed _ p _
  | alts _ [p]  => p.name?
  | _           => none

/-- Get the syntax node from which this pattern was parsed. Used for error messages -/
def ref : RCasesPatt → Syntax
  | paren ref _
  | one ref _
  | clear ref
  | explicit ref _
  | typed ref _ _
  | tuple ref _
  | alts ref _ => ref

/--
Interpret an rcases pattern as a tuple, where `p` becomes `⟨p⟩` if `p` is not already a tuple.
-/
def asTuple : RCasesPatt → Bool × ListΠ RCasesPatt
  | paren _ p    => p.asTuple
  | explicit _ p => (true, p.asTuple.2)
  | tuple _ ps   => (false, ps)
  | p            => (false, [p])

/--
Interpret an rcases pattern as an alternation, where non-alternations are treated as one
alternative.
-/
def asAlts : RCasesPatt → ListΣ RCasesPatt
  | paren _ p => p.asAlts
  | alts _ ps => ps
  | p         => [p]

/-- Convert a list of patterns to a tuple pattern, but mapping `[p]` to `p` instead of `⟨p⟩`. -/
def typed? (ref : Syntax) : RCasesPatt → Option Term → RCasesPatt
  | p, none => p
  | p, some ty => typed ref p ty

/-- Convert a list of patterns to a tuple pattern, but mapping `[p]` to `p` instead of `⟨p⟩`. -/
def tuple' : ListΠ RCasesPatt → RCasesPatt
  | [p] => p
  | ps  => tuple (ps.head?.map (·.ref) |>.getD .missing) ps

/--
Convert a list of patterns to an alternation pattern, but mapping `[p]` to `p` instead of
a unary alternation `|p`.
-/
def alts' (ref : Syntax) : ListΣ RCasesPatt → RCasesPatt
  | [p] => p
  | ps  => alts ref ps

/--
This function is used for producing rcases patterns based on a case tree. Suppose that we have
a list of patterns `ps` that will match correctly against the branches of the case tree for one
constructor. This function will merge tuples at the end of the list, so that `[a, b, ⟨c, d⟩]`
becomes `⟨a, b, c, d⟩` instead of `⟨a, b, ⟨c, d⟩⟩`.

We must be careful to turn `[a, ⟨⟩]` into `⟨a, ⟨⟩⟩` instead of `⟨a⟩` (which will not perform the
nested match).
-/
def tuple₁Core : ListΠ RCasesPatt → ListΠ RCasesPatt
  | []         => []
  | [tuple ref []] => [tuple ref []]
  | [tuple _ ps] => ps
  | p :: ps    => p :: tuple₁Core ps

/--
This function is used for producing rcases patterns based on a case tree. This is like
`tuple₁Core` but it produces a pattern instead of a tuple pattern list, converting `[n]` to `n`
instead of `⟨n⟩` and `[]` to `_`, and otherwise just converting `[a, b, c]` to `⟨a, b, c⟩`.
-/
def tuple₁ : ListΠ RCasesPatt → RCasesPatt
  | []      => default
  | [one ref n] => one ref n
  | ps      => tuple ps.head!.ref $ tuple₁Core ps

/--
This function is used for producing rcases patterns based on a case tree. Here we are given
the list of patterns to apply to each argument of each constructor after the main case, and must
produce a list of alternatives with the same effect. This function calls `tuple₁` to make the
individual alternatives, and handles merging `[a, b, c | d]` to `a | b | c | d` instead of
`a | b | (c | d)`.
-/
def alts₁Core : ListΣ (ListΠ RCasesPatt) → ListΣ RCasesPatt
  | []          => []
  | [[alts _ ps]] => ps
  | p :: ps     => tuple₁ p :: alts₁Core ps

/--
This function is used for producing rcases patterns based on a case tree. This is like
`alts₁Core`, but it produces a cases pattern directly instead of a list of alternatives. We
specially translate the empty alternation to `⟨⟩`, and translate `|(a | b)` to `⟨a | b⟩` (because we
don't have any syntax for unary alternation). Otherwise we can use the regular merging of
alternations at the last argument so that `a | b | (c | d)` becomes `a | b | c | d`.
-/
def alts₁ (ref : Syntax) : ListΣ (ListΠ RCasesPatt) → RCasesPatt
  | [[]]        => tuple .missing []
  | [[alts ref ps]] => tuple ref ps
  | ps          => alts' ref $ alts₁Core ps

open MessageData in
partial instance : ToMessageData RCasesPatt := ⟨fmt 0⟩ where
  /-- parenthesize the message if the precedence is above `tgt` -/
  parenAbove (tgt p : Nat) (m : MessageData) : MessageData :=
    if tgt < p then m.paren else m
  /-- format an `RCasesPatt` with the given precedence: 0 = lo, 1 = med, 2 = hi -/
  fmt : Nat → RCasesPatt → MessageData
  | p, paren _ pat => fmt p pat
  | _, one _ n => n
  | _, clear _ => "-"
  | _, explicit _ pat => m!"@{fmt 2 pat}"
  | p, typed _ pat ty => parenAbove 0 p m!"{fmt 1 pat}: {ty}"
  | _, tuple _ pats => bracket "⟨" (joinSep (pats.map (fmt 0)) ("," ++ Format.line)) "⟩"
  | p, alts _ pats => parenAbove 1 p (joinSep (pats.map (fmt 2)) " | ")

end RCasesPatt

/--
Takes the number of fields of a single constructor and patterns to match its fields against
(not necessarily the same number). The returned lists each contain one element per field of the
constructor. The `name` is the name which will be used in the top-level `cases` tactic, and the
`rcases_patt` is the pattern which the field will be matched against by subsequent `cases`
tactics.
-/
def processConstructor (ref : Syntax) (info : Array ParamInfo)
    (explicit : Bool) (idx : Nat) (ps : ListΠ RCasesPatt) : ListΠ Name × ListΠ RCasesPatt :=
  if _ : idx < info.size then
    if !explicit && info[idx].binderInfo != .default then
      let (ns, tl) := processConstructor ref info explicit (idx+1) ps
      (`_ :: ns, default :: tl)
    else if idx+1 < info.size then
      let p := ps.headD default
      let (ns, tl) := processConstructor ref info explicit (idx+1) (ps.tailD [])
      (p.name?.getD `_ :: ns, p :: tl)
    else match ps with
      | []  => ([`_], [default])
      | [p] => ([p.name?.getD `_], [p])
      | ps  => ([`_], [(bif explicit then .explicit ref else id) (.tuple ref ps)])
  else ([], [])
termination_by _ => info.size - idx

/--
Takes a list of constructor names, and an (alternation) list of patterns, and matches each
pattern against its constructor. It returns the list of names that will be passed to `cases`,
and the list of `(constructor name, patterns)` for each constructor, where `patterns` is the
(conjunctive) list of patterns to apply to each constructor argument.
-/
def processConstructors (ref : Syntax) (params : Nat) (altVarNames : Array AltVarNames := #[]) :
    ListΣ Name → ListΣ RCasesPatt → MetaM (Array AltVarNames × ListΣ (Name × ListΠ RCasesPatt))
  | [], _ => pure (altVarNames, [])
  | c :: cs, ps => do
    let info := (← getFunInfo (← mkConstWithLevelParams c)).paramInfo
    let p := ps.headD default
    let t := ps.tailD []
    let ((explicit, h), t) := match cs, t with
    | [], _ :: _ => ((false, [RCasesPatt.alts ref ps]), [])
    | _,  _      => (p.asTuple, t)
    let (ns, ps) := processConstructor p.ref info explicit params h
    let (altVarNames, r) ← processConstructors ref params (altVarNames.push ⟨true, ns⟩) cs t
    pure (altVarNames, (c, ps) :: r)

open Elab Tactic

-- TODO(Mario): this belongs in core
/-- Like `Lean.Meta.subst`, but preserves the `FVarSubst`. -/
def subst' (goal : MVarId) (hFVarId : FVarId)
  (fvarSubst : FVarSubst := {}) : MetaM (FVarSubst × MVarId) := do
  let hLocalDecl ← hFVarId.getDecl
  let error {α} _ : MetaM α := throwTacticEx `subst goal
    m!"invalid equality proof, it is not of the form (x = t) or (t = x){indentExpr hLocalDecl.type}"
  let some (_, lhs, rhs) ← matchEq? hLocalDecl.type | error ()
  let substReduced (newType : Expr) (symm : Bool) : MetaM (FVarSubst × MVarId) := do
    let goal ← goal.assert hLocalDecl.userName newType (mkFVar hFVarId)
    let (hFVarId', goal) ← goal.intro1P
    let goal ← goal.clear hFVarId
    substCore goal hFVarId' (symm := symm) (tryToSkip := true) (fvarSubst := fvarSubst)
  let rhs' ← whnf rhs
  if rhs'.isFVar then
    if rhs != rhs' then
      substReduced (← mkEq lhs rhs') true
    else
      substCore goal hFVarId (symm := true) (tryToSkip := true) (fvarSubst := fvarSubst)
  else
    let lhs' ← whnf lhs
    if lhs'.isFVar then
      if lhs != lhs' then
        substReduced (← mkEq lhs' rhs) false
      else
        substCore goal hFVarId (symm := false) (tryToSkip := true) (fvarSubst := fvarSubst)
    else error ()

mutual

/--
This will match a pattern `pat` against a local hypothesis `e`.
* `g`: The initial subgoal
* `fs`: A running variable substitution, the result of `cases` operations upstream.
  The variable `e` must be run through this map before locating it in the context of `g`,
  and the output variable substitutions will be end extensions of this one.
* `clears`: The list of variables to clear in all subgoals generated from this point on.
  We defer clear operations because clearing too early can cause `cases` to fail.
  The actual clearing happens in `RCases.finish`.
* `e`: a local hypothesis, the scrutinee to match against.
* `a`: opaque "user data" which is passed through all the goal calls at the end.
* `pat`: the pattern to match against
* `cont`: A continuation. This is called on every goal generated by the result of the pattern
  match, with updated values for `g` , `fs`, `clears`, and `a`.
-/
partial def rcasesCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (e : Expr) (a : α)
    (pat : RCasesPatt) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) :
    TermElabM α := do
  let asFVar : Expr → MetaM _
    | .fvar e => pure e
    | e => throwError "rcases tactic failed: {e} is not a fvar"
  withRef pat.ref <| g.withContext do match pat with
  | .one ref `rfl =>
    -- Note: the mdata prevents the span from getting highlighted like a variable
    Term.addTermInfo' ref (.mdata {} e)
    let (fs, g) ← subst' g (← asFVar (fs.apply e)) fs
    cont g fs clears a
  | .one ref _ =>
    if e.isFVar then
      Term.addLocalVarInfo ref e
    cont g fs clears a
  | .clear ref =>
    Term.addTermInfo' ref (.mdata {} e)
    cont g fs (if let .fvar e := e then clears.push e else clears) a
  | .typed ref pat ty =>
    Term.addTermInfo' ref (.mdata {} e)
    let expected ← Term.elabType ty
    let e := fs.apply e
    let etype ← inferType e
    unless ← isDefEq etype expected do
      Term.throwTypeMismatchError "rcases: scrutinee" expected etype e
    let g ← if let .fvar e := e then g.replaceLocalDeclDefEq e expected else pure g
    rcasesCore g fs clears e a pat cont
  | .paren ref p
  | .alts ref [p] =>
    Term.addTermInfo' ref (.mdata {} e)
    rcasesCore g fs clears e a p cont
  | _ =>
    Term.addTermInfo' pat.ref (.mdata {} e)
    let e := fs.apply e
    let _ ← asFVar e
    let type ← whnfD (← inferType e)
    let failK {α} _ : TermElabM α :=
      throwError "rcases tactic failed: {e} : {type} is not an inductive datatype"
    let (r, subgoals) ← matchConst type.getAppFn failK fun
      | ConstantInfo.quotInfo info, _ => do
        unless info.kind matches QuotKind.type do failK ()
        let pat := pat.asAlts.headD default
        let (explicit, pat₁) := pat.asTuple
        let ([x], ps) := processConstructor pat.ref #[{}] explicit 0 pat₁ | unreachable!
        let (vars, g) ← g.revert (← getFVarsToGeneralize #[e])
        g.withContext do
          let elimInfo ← getElimInfo `Quot.ind
          let res ← ElimApp.mkElimApp elimInfo #[e] (← g.getTag)
          let elimArgs := res.elimApp.getAppArgs
          ElimApp.setMotiveArg g elimArgs[elimInfo.motivePos]!.mvarId! #[e.fvarId!]
          g.assign res.elimApp
          let #[{ name := n, mvarId := g, .. }] := res.alts | unreachable!
          let (v, g) ← g.intro x
          let (varsOut, g) ← g.introNP vars.size
          let fs' := (vars.zip varsOut).foldl (init := fs) fun fs (v, w) => fs.insert v (mkFVar w)
          pure ([(n, ps)], #[⟨⟨g, #[mkFVar v], fs'⟩, n⟩])
      | ConstantInfo.inductInfo info, _ => do
        let (altVarNames, r) ← processConstructors pat.ref info.numParams #[] info.ctors pat.asAlts
        (r, ·) <$> g.cases e.fvarId! altVarNames
      | _, _ => failK ()
    (·.2) <$> subgoals.foldlM (init := (r, a)) fun (r, a) ⟨goal, ctorName⟩ => do
      let rec
      /-- Runs `rcasesContinue` on the first pattern in `r` with a matching `ctorName`.
      The unprocessed patterns (subsequent to the matching pattern) are returned. -/
      align : ListΠ (Name × ListΠ RCasesPatt) → TermElabM (ListΠ (Name × ListΠ RCasesPatt) × α)
      | [] => pure ([], a)
      | (tgt, ps) :: as => do
        if tgt == ctorName then
          let fs := fs.append goal.subst
          (as, ·) <$> rcasesContinue goal.mvarId fs clears a (ps.zip goal.fields.toList) cont
        else
          align as
      align r

/--
This will match a list of patterns against a list of hypotheses `e`. The arguments are similar
to `rcasesCore`, but the patterns and local variables are in `pats`. Because the calls are all
nested in continuations, later arguments can be matched many times, once per goal produced by
earlier arguments. For example `⟨a | b, ⟨c, d⟩⟩` performs the `⟨c, d⟩` match twice, once on the
`a` branch and once on `b`.
-/
partial def rcasesContinue (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a : α)
  (pats : ListΠ (RCasesPatt × Expr)) (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) :
  TermElabM α :=
  match pats with
  | []  => cont g fs clears a
  | ((pat, e) :: ps) =>
    rcasesCore g fs clears e a pat fun g fs clears a =>
      rcasesContinue g fs clears a ps cont

end

/-- Like `tryClearMany`, but also clears dependent hypotheses if possible -/
def tryClearMany' (goal : MVarId) (fvarIds : Array FVarId) : MetaM MVarId := do
  let mut toErase := fvarIds
  for localDecl in (← goal.getDecl).lctx do
    if ← findLocalDeclDependsOn localDecl toErase.contains then
      toErase := toErase.push localDecl.fvarId
  goal.tryClearMany toErase

/--
The terminating continuation used in `rcasesCore` and `rcasesContinue`. We specialize the type
`α` to `Array MVarId` to collect the list of goals, and given the list of `clears`, it attempts to
clear them from the goal and adds the goal to the list.
-/
def finish (g : MVarId) (fs : FVarSubst) (clears : Array FVarId)
  (gs : Array MVarId) : TermElabM (Array MVarId) := do
  let cs : Array Expr := (clears.map fs.get).filter Expr.isFVar
  gs.push <$> tryClearMany' g (cs.map Expr.fvarId!)

open Elab

/-- Parses a `Syntax` into the `RCasesPatt` type used by the `RCases` tactic. -/
partial def RCasesPatt.parse (stx : Syntax) : MetaM RCasesPatt :=
  match stx with
  | `(rcasesPatMed| $ps:rcasesPat|*) => return .alts' stx (← ps.getElems.toList.mapM (parse ·.raw))
  | `(rcasesPatLo| $pat:rcasesPatMed : $t:term) => return .typed stx (← parse pat) t
  | `(rcasesPatLo| $pat:rcasesPatMed) => parse pat
  | `(rcasesPat| _) => return .one stx `_
  | `(rcasesPat| $h:ident) => return .one h h.getId
  | `(rcasesPat| -) => return .clear stx
  | `(rcasesPat| @$pat) => return .explicit stx (← parse pat)
  | `(rcasesPat| ⟨$ps,*⟩) => return .tuple stx (← ps.getElems.toList.mapM (parse ·.raw))
  | `(rcasesPat| ($pat)) => return .paren stx (← parse pat)
  | _ => throwUnsupportedSyntax

-- extracted from elabCasesTargets
/-- Generalize all the arguments as specified in `args` to fvars if they aren't already -/
def generalizeExceptFVar (goal : MVarId) (args : Array GeneralizeArg) :
    MetaM (Array Expr × MVarId) := do
  let argsToGeneralize := args.filter fun arg => !(arg.expr.isFVar && arg.hName?.isNone)
  let (fvarIdsNew, goal) ← goal.generalize argsToGeneralize
  let mut result := #[]
  let mut j := 0
  for arg in args do
    if arg.expr.isFVar && arg.hName?.isNone then
      result := result.push arg.expr
    else
      result := result.push (mkFVar fvarIdsNew[j]!)
      j := j+1
  pure (result, goal)

/--
Given a list of targets of the form `e` or `h : e`, and a pattern, match all the targets
against the pattern. Returns the list of produced subgoals.
-/
def rcases (tgts : Array (Option Name × Syntax))
  (pat : RCasesPatt) (g : MVarId) : TermElabM (List MVarId) := do
  let pats ← match tgts.size with
  | 0 => return [g]
  | 1 => pure [pat]
  | _ => pure (processConstructor pat.ref (tgts.map fun _ => {}) false 0 pat.asTuple.2).2
  let (pats, args) := Array.unzip <|← (tgts.zip pats.toArray).mapM fun ((hName?, tgt), pat) => do
    let (pat, ty) ← match pat with
    | .typed ref pat ty => withRef ref do
      let ty ← Term.elabType ty
      pure (.typed ref pat (← Term.exprToSyntax ty), some ty)
    | _ => pure (pat, none)
    let expr ← Term.ensureHasType ty (← Term.elabTerm tgt ty)
    pure (pat, { expr, xName? := pat.name?, hName? : GeneralizeArg })
  let (vs, g) ← generalizeExceptFVar g args
  let gs ← rcasesContinue g {} #[] #[] (pats.zip vs).toList finish
  pure gs.toList

/--
The `obtain` tactic in the no-target case. Given a type `T`, create a goal `|- T` and
and pattern match `T` against the given pattern. Returns the list of goals, with the assumed goal
first followed by the goals produced by the pattern match.
-/
def obtainNone (pat : RCasesPatt) (ty : Syntax) (g : MVarId) : TermElabM (List MVarId) := do
  let ty ← Term.elabType ty
  let g₁ ← mkFreshExprMVar (some ty)
  let (v, g₂) ← (← g.assert (pat.name?.getD default) ty g₁).intro1
  let gs ← rcasesCore g₂ {} #[] (.fvar v) #[] pat finish
  pure (g₁.mvarId! :: gs.toList)

mutual
variable [Monad m] [MonadQuotation m]

/-- Expand a `rintroPat` into an equivalent list of `rcasesPat` patterns. -/
partial def expandRIntroPat (pat : TSyntax `rintroPat)
    (acc : Array (TSyntax `rcasesPat) := #[]) (ty? : Option Term := none) :
    Array (TSyntax `rcasesPat) :=
  match pat with
  | `(rintroPat| $p:rcasesPat) => match ty? with
    | some ty => acc.push <| Unhygienic.run <| withRef p `(rcasesPat| ($p:rcasesPat : $ty))
    | none => acc.push p
  | `(rintroPat| ($(pats)* $[: $ty?']?)) => expandRIntroPats pats acc (ty?' <|> ty?)
  | _ => acc

/-- Expand a list of `rintroPat` into an equivalent list of `rcasesPat` patterns. -/
partial def expandRIntroPats (pats : Array (TSyntax `rintroPat))
    (acc : Array (TSyntax `rcasesPat) := #[]) (ty? : Option Term := none) :
    Array (TSyntax `rcasesPat) :=
  pats.foldl (fun acc p => expandRIntroPat p acc ty?) acc

end

mutual

/--
This introduces the pattern `pat`. It has the same arguments as `rcasesCore`, plus:
* `ty?`: the nearest enclosing type ascription on the current pattern
-/
partial def rintroCore (g : MVarId) (fs : FVarSubst) (clears : Array FVarId) (a : α)
  (ref : Syntax) (pat : TSyntax `rintroPat) (ty? : Option Term)
  (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : TermElabM α := do
  match pat with
  | `(rintroPat| $pat:rcasesPat) =>
    let pat := (← RCasesPatt.parse pat).typed? ref ty?
    let (v, g) ← g.intro (pat.name?.getD `_)
    rcasesCore g fs clears (.fvar v) a pat cont
  | `(rintroPat| ($(pats)* $[: $ty?']?)) =>
    let ref := if pats.size == 1 then pat.raw else .missing
    rintroContinue g fs clears ref pats (ty?' <|> ty?) a cont
  | _ => throwUnsupportedSyntax

/--
This introduces the list of patterns `pats`. It has the same arguments as `rcasesCore`, plus:
* `ty?`: the nearest enclosing type ascription on the current pattern
-/
partial def rintroContinue (g : MVarId) (fs : FVarSubst) (clears : Array FVarId)
  (ref : Syntax) (pats : TSyntaxArray `rintroPat) (ty? : Option Term) (a : α)
  (cont : MVarId → FVarSubst → Array FVarId → α → TermElabM α) : TermElabM α := do
  g.withContext (loop 0 g fs clears a)
where
  /-- Runs `rintroContinue` on `pats[i:]` -/
  loop i g fs clears a := do
    if h : i < pats.size then
      rintroCore g fs clears a ref (pats.get ⟨i, h⟩) ty? (loop (i+1))
    else cont g fs clears a

end

/--
The implementation of the `rintro` tactic. It takes a list of patterns `pats` and
an optional type ascription `ty?` and introduces the patterns, resulting in zero or more goals.
-/
def rintro (pats : TSyntaxArray `rintroPat) (ty? : Option Term)
  (g : MVarId) : TermElabM (List MVarId) :=
  (·.toList) <$> rintroContinue g {} #[] .missing pats ty? #[] finish

end RCases

open Lean Elab Elab.Tactic Meta RCases Parser.Tactic

/- TODO
/--
`rcases? e` will perform case splits on `e` in the same way as `rcases e`,
but rather than accepting a pattern, it does a maximal cases and prints the
pattern that would produce this case splitting. The default maximum depth is 5,
but this can be modified with `rcases? e : n`.
-/
elab (name := rcases?) "rcases?" _tgts:casesTarget,* _num:(" : " num)? : tactic =>
  throwError "unimplemented"
-/

/--
`rcases` is a tactic that will perform `cases` recursively, according to a pattern. It is used to
destructure hypotheses or expressions composed of inductive types like `h1 : a ∧ b ∧ c ∨ d` or
`h2 : ∃ x y, trans_rel R x y`. Usual usage might be `rcases h1 with ⟨ha, hb, hc⟩ | hd` or
`rcases h2 with ⟨x, y, _ | ⟨z, hxz, hzy⟩⟩` for these examples.

Each element of an `rcases` pattern is matched against a particular local hypothesis (most of which
are generated during the execution of `rcases` and represent individual elements destructured from
the input expression). An `rcases` pattern has the following grammar:

* A name like `x`, which names the active hypothesis as `x`.
* A blank `_`, which does nothing (letting the automatic naming system used by `cases` name the
  hypothesis).
* A hyphen `-`, which clears the active hypothesis and any dependents.
* The keyword `rfl`, which expects the hypothesis to be `h : a = b`, and calls `subst` on the
  hypothesis (which has the effect of replacing `b` with `a` everywhere or vice versa).
* A type ascription `p : ty`, which sets the type of the hypothesis to `ty` and then matches it
  against `p`. (Of course, `ty` must unify with the actual type of `h` for this to work.)
* A tuple pattern `⟨p1, p2, p3⟩`, which matches a constructor with many arguments, or a series
  of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`,
  then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b`
  and so on.
* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor,
  while leaving the `@` off will only use the patterns on the explicit arguments.
* An alteration pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors,
  or a nested disjunction like `a ∨ b ∨ c`.

A pattern like `⟨a, b, c⟩ | ⟨d, e⟩` will do a split over the inductive datatype,
naming the first three parameters of the first constructor as `a,b,c` and the
first two of the second constructor `d,e`. If the list is not as long as the
number of arguments to the constructor or the number of constructors, the
remaining variables will be automatically named. If there are nested brackets
such as `⟨⟨a⟩, b | c⟩ | d` then these will cause more case splits as necessary.
If there are too many arguments, such as `⟨a, b, c⟩` for splitting on
`∃ x, ∃ y, p x`, then it will be treated as `⟨a, ⟨b, c⟩⟩`, splitting the last
parameter as necessary.

`rcases` also has special support for quotient types: quotient induction into Prop works like
matching on the constructor `quot.mk`.

`rcases h : e with PAT` will do the same as `rcases e with PAT` with the exception that an
assumption `h : e = PAT` will be added to the context.
-/
elab (name := rcases) tk:"rcases" tgts:casesTarget,* pat:((" with " rcasesPatLo)?) : tactic => do
  let pat ← match pat.raw.getArgs with
  | #[_, pat] => RCasesPatt.parse pat
  | #[] => pure $ RCasesPatt.tuple tk []
  | _ => throwUnsupportedSyntax
  let tgts := tgts.getElems.map fun tgt =>
    (if tgt.raw[0].isNone then none else some tgt.raw[0][0].getId, tgt.raw[1])
  let g ← getMainGoal
  g.withContext do replaceMainGoal (← RCases.rcases tgts pat g)

/--
The `obtain` tactic is a combination of `have` and `rcases`. See `rcases` for
a description of supported patterns.

```lean
obtain ⟨patt⟩ : type := proof
```
is equivalent to
```lean
have h : type := proof
rcases h with ⟨patt⟩
```

If `⟨patt⟩` is omitted, `rcases` will try to infer the pattern.

If `type` is omitted, `:= proof` is required.
-/
elab (name := obtain) tk:"obtain"
    pat:(ppSpace rcasesPatMed)? ty:((" : " term)?) val:((" := " term,+)?) : tactic => do
  let pat ← liftM $ pat.mapM RCasesPatt.parse
  if val.raw.isNone then
    if ty.raw.isNone then throwError
        ("`obtain` requires either an expected type or a value.\n" ++
        "usage: `obtain ⟨patt⟩? : type (:= val)?` or `obtain ⟨patt⟩? (: type)? := val`")
    let pat := pat.getD (RCasesPatt.one tk `this)
    let g ← getMainGoal
    g.withContext do replaceMainGoal (← RCases.obtainNone pat ty.raw[1] g)
  else
    let pat := pat.getD (RCasesPatt.one tk `_)
    let pat := pat.typed? tk $ if ty.raw.isNone then none else some ⟨ty.raw[1]⟩
    let tgts := val.raw[1].getSepArgs.map fun val => (none, val)
    let g ← getMainGoal
    g.withContext do replaceMainGoal (← RCases.rcases tgts pat g)

/- TODO
/--
`rintro?` will introduce and case split on variables in the same way as
`rintro`, but will also print the `rintro` invocation that would have the same
result. Like `rcases?`, `rintro? : n` allows for modifying the
depth of splitting; the default is 5.
-/
elab (name := rintro?) "rintro?" (" : " num)? : tactic =>
  throwError "unimplemented"
-/

/--
The `rintro` tactic is a combination of the `intros` tactic with `rcases` to
allow for destructuring patterns while introducing variables. See `rcases` for
a description of supported patterns. For example, `rintro (a | ⟨b, c⟩) ⟨d, e⟩`
will introduce two variables, and then do case splits on both of them producing
two subgoals, one with variables `a d e` and the other with `b c d e`.

`rintro`, unlike `rcases`, also supports the form `(x y : ty)` for introducing
and type-ascripting multiple variables at once, similar to binders.
-/
elab (name := rintro) "rintro" pats:(ppSpace colGt rintroPat)+ ty:((" : " term)?) : tactic => do
  let ty? := if ty.raw.isNone then none else some ⟨ty.raw[1]⟩
  let g ← getMainGoal
  g.withContext do replaceMainGoal (← RCases.rintro pats ty? g)


import Kenny.sandbox

universes u v w u₁ v₁ w₁

namespace ulift

variables (X : Type u) [topological_space X]

instance : topological_space (ulift.{v} X) :=
topological_space.coinduced ulift.up _inst_1

end ulift

theorem continuous_up {X : Type u} [topological_space X] : continuous (ulift.up : X → ulift.{v} X) :=
λ U, id

theorem continuous_down {X : Type u} [topological_space X] : continuous (ulift.down : ulift.{v} X → X) :=
λ U, id

structure open_subspace (X : Type u) [topological_space X] :=
(U : Type v)
[top : topological_space U]
(inc : U → X)
(inj : function.injective inc)
(cont : continuous inc)
(op : ∀ {V : set U}, is_open V → is_open (inc '' V))
attribute [instance] open_subspace.top

namespace open_subspace

variables (X : Type u) [topological_space X]

instance : has_coe_to_sort (open_subspace X) :=
⟨_, open_subspace.U⟩

instance (U : open_subspace X) : topological_space U :=
U.top

def of_set (U : set X) (HU : is_open U) : open_subspace.{u u} X :=
{ U := U,
  inc := subtype.val,
  inj := subtype.val_injective,
  cont := continuous_induced_dom,
  op := λ V ⟨S, HS, HSV⟩, by rw [← HSV, subtype.image_preimage_val]; exact is_open_inter HS HU }

protected def ulift (U : open_subspace X) : open_subspace X :=
{ U := ulift U,
  inc := λ x, U.inc x.down,
  inj := function.injective_comp U.inj $ function.injective_of_left_inverse $ ulift.up_down,
  cont := U.cont.comp continuous_down,
  op := λ V HV, by rw [set.image_comp, set.image_eq_preimage_of_inverse ulift.up_down ulift.down_up];
    exact U.op (continuous_up _ HV) }

-- instance : has_inter (open_subspace X) :=
-- ⟨λ U V,
-- { U := { p : U × V // U.inc p.1 = V.inc p.2 },
--   inc := λ p, U.inc p.1.1,
--   inj := λ p q H, subtype.eq $ prod.ext (U.inj H) $ V.inj $
--     calc  V.inc p.1.2
--         = U.inc p.1.1 : p.2.symm
--     ... = U.inc q.1.1 : H
--     ... = V.inc q.1.2 : q.2,
--   cont := continuous.comp (continuous.comp continuous_induced_dom continuous_fst) U.cont,
--   op := λ W HW, by rw set.image_comp; exact U.op _ }⟩

end open_subspace

namespace gluing_data

protected structure topological_space :=
(left : Type u)
(right : Type v)
[topl : topological_space left]
[topr : topological_space right]
(osl : open_subspace left)
(osr : open_subspace right)
(maplr : osl → osr)
(maprl : osr → osl)
(contlr : continuous maplr)
(contrl : continuous maprl)
(lrl : ∀ x, maprl (maplr x) = x)
(rlr : ∀ x, maplr (maprl x) = x)
attribute [instance] gluing_data.topological_space.topl gluing_data.topological_space.topr

end gluing_data

namespace gluing

inductive topological_space.r (d : gluing_data.topological_space) :
  d.left ⊕ d.right → d.left ⊕ d.right → Prop
| refl : ∀ p, topological_space.r p p
| inlr : ∀ p : d.osl, topological_space.r (sum.inl (d.osl.inc p)) (sum.inr (d.osr.inc (d.maplr p)))
| inrl : ∀ p : d.osr, topological_space.r (sum.inr (d.osr.inc p)) (sum.inl (d.osl.inc (d.maprl p)))
attribute [refl] topological_space.r.refl

instance topological_space.setoid (d : gluing_data.topological_space) :
  setoid (d.left ⊕ d.right) :=
{ r := topological_space.r d,
  iseqv := ⟨topological_space.r.refl,
  begin
    rintros (p|p) (q|q) h,
    { cases h, refl },
    { cases h with _ p, convert topological_space.r.inrl (d.maplr p), rw d.lrl },
    { cases h with _ _ p, convert topological_space.r.inlr (d.maprl p), rw d.rlr },
    { cases h, refl }
  end,
  begin
    rintros (p|p) (q|q) r h1 h2,
    { cases h1, exact h2 },
    { cases h2,
      case gluing.topological_space.r.refl { exact h1 },
      case gluing.topological_space.r.inrl : q {
        generalize_hyp hr : d.osr.inc q = r at h1, cases h1 with _ r,
        replace hr := d.osr.inj hr, subst hr, rw d.lrl } },
    { cases h2,
      case gluing.topological_space.r.refl { exact h1 },
      case gluing.topological_space.r.inlr : q {
        generalize_hyp hr : d.osl.inc q = r at h1, cases h1 with _ r,
        replace hr := d.osl.inj hr, subst hr, rw d.rlr } },
    { cases h1, exact h2 }
  end⟩ }

protected def topological_space (d : gluing_data.topological_space) : Type* :=
quotient $ topological_space.setoid d

end gluing

namespace projective_line

end projective_line


import Radon.main
import Radon.png_reflects_limits

open_locale nnreal big_operators classical

noncomputable theory

open category_theory
open category_theory.limits
open topological_space

local attribute [instance]
  locally_constant.seminormed_add_comm_group
  locally_constant.pseudo_metric_space

namespace Profinite

variables (X : Profinite.{0}) (p : ℝ≥0)
instance why_do_I_need_this : add_comm_group (weak_dual ℝ C(X,ℝ)) :=
show add_comm_group (C(X,ℝ) →L[ℝ] ℝ), by apply_instance

lemma bdd_neg {c} (a : weak_dual ℝ C(X,ℝ)) (ha : a.bdd p c) : (-a).bdd p c :=
λ e, by simpa only [continuous_linear_map.neg_apply, nnnorm_neg] using ha e

section p_pos
variables [fact (0 < p)]

lemma bdd_zero : (0 : weak_dual ℝ C(X,ℝ)).bdd p 0 :=
λ e, by {
  refine (finset.sum_eq_zero (λ x hx, _)).le,
  rw [continuous_linear_map.zero_apply, nnnorm_zero],
  exact nnreal.rpow_eq_zero_iff.mpr ⟨rfl, (nnreal.coe_pos.mpr (fact.out _)).ne'⟩ }

section p_le_one
variables [fact (p ≤ 1)]

lemma bdd_add {ca cb} (a b : weak_dual ℝ C(X,ℝ)) (ha : a.bdd p ca) (hb : b.bdd p cb) :
  (a + b).bdd p (ca + cb) :=
begin
  intros e,
  --  `dsimp` is unneeded and slowly changes the goal to
  -- `∑ (t : ↥e), ∥⇑a (e.fibre t).indicator + ⇑b (e.fibre t).indicator∥₊ ^ ↑p ≤ ca + cb`,
  refine le_trans _ (add_le_add (ha e) (hb e)),
  rw ← finset.sum_add_distrib,
  apply finset.sum_le_sum, rintros i -,
  refine le_trans _ (nnreal.rpow_add_le_add_rpow _ _ _ $
    (nnreal.coe_le_coe.mpr (fact.out _)).trans nnreal.coe_one.le),
  refine nnreal.rpow_le_rpow _ _,
  { apply nnnorm_add_le },
  repeat { exact (nnreal.coe_pos.mpr (fact.out _)).le },
end

/-- An auxiliary definition to be used in the constructions below. -/
def bdd_weak_dual : add_subgroup (weak_dual ℝ C(X,ℝ)) :=
{ carrier := { μ | ∃ c, μ.bdd p c },
  add_mem' := λ a b ha hb, begin
    obtain ⟨ca, ha⟩ := ha,
    obtain ⟨cb, hb⟩ := hb,
    use ca + cb,
    apply bdd_add _ _ _ _ ha hb,
  end,
  zero_mem' := ⟨0, bdd_zero _ _⟩,
  neg_mem' := λ a ha, begin
    obtain ⟨c,ha⟩ := ha,
    use c,
    apply bdd_neg _ _ _ ha,
  end }

instance : pseudo_normed_group (X.bdd_weak_dual p) :=
{ filtration := λ c, {μ | μ.1.bdd p c},
  filtration_mono := λ c₁ c₂ h μ hμ e, by apply le_trans (hμ e) h,
  zero_mem_filtration := λ c e, le_trans (bdd_zero _ _ _) (zero_le _),
  neg_mem_filtration := λ c μ hμ e, bdd_neg _ _ _ hμ _,
  add_mem_filtration := λ c₁ c₂ a b ha hb, bdd_add _ _ _ _ ha hb }

instance topological_space_bdd_weak_dual_filtration (c : ℝ≥0) :
  topological_space (pseudo_normed_group.filtration (X.bdd_weak_dual p) c) :=
topological_space.induced (λ μ, μ.1.1) infer_instance

/-- An auxiliary definition to be used in the constructions below. -/
def bdd_weak_dual_filtration_homeo (c : ℝ≥0) :
  (pseudo_normed_group.filtration (X.bdd_weak_dual p) c) ≃ₜ
  X.Radon p c :=
{ to_fun := λ μ, ⟨μ.1.1, μ.2⟩,
  inv_fun := λ μ, ⟨⟨μ.1, ⟨c, μ.2⟩⟩, μ.2⟩,
  left_inv := λ μ, by { ext, refl },
  right_inv := λ μ, by { ext, refl },
  continuous_to_fun := begin
    apply continuous.subtype_mk,
    exact continuous_induced_dom,
  end,
  continuous_inv_fun := begin
    rw continuous_induced_rng,
    exact continuous_subtype_coe
  end }

instance : comphaus_filtered_pseudo_normed_group (X.bdd_weak_dual p) :=
{ t2 := λ c, (X.bdd_weak_dual_filtration_homeo p c).symm.t2_space,
  compact := λ c, (X.bdd_weak_dual_filtration_homeo p c).symm.compact_space,
  continuous_add' := begin
    intros c₁ c₂,
    rw continuous_induced_rng,
    let i1 :
      (pseudo_normed_group.filtration ↥(X.bdd_weak_dual p) c₁) ×
      (pseudo_normed_group.filtration ↥(X.bdd_weak_dual p) c₂) →
      weak_dual ℝ C(X,ℝ) × weak_dual ℝ C(X,ℝ) :=
      prod.map (λ μ, μ.1.1) (λ μ, μ.1.1),
    let i2 :
      weak_dual ℝ C(X,ℝ) × weak_dual ℝ C(X,ℝ) → weak_dual ℝ C(X,ℝ) :=
      (λ a, a.1 + a.2),
    change continuous (i2 ∘ i1),
    apply continuous.comp,
    exact continuous_add,
    refine continuous.prod_map _ _,
    exact continuous_induced_dom,
    exact continuous_induced_dom,
  end,
  continuous_neg' := begin
    intros c,
    rw continuous_induced_rng,
    let i1 :
      (pseudo_normed_group.filtration ↥(X.bdd_weak_dual p) c) →
      weak_dual ℝ C(X,ℝ) := λ μ, μ.1.1,
    let i2 : weak_dual ℝ C(X,ℝ) → weak_dual ℝ C(X,ℝ) := λ μ, -μ,
    change continuous (i2 ∘ i1),
    apply continuous.comp,
    apply weak_dual.continuous_of_continuous_eval,
    intros f,
    dsimp [i2],
    have : (λ (a : weak_dual ℝ C(↥X, ℝ)), -a f) =
      (λ (a : weak_dual ℝ C(↥X, ℝ)), a (-f)), by { ext, simp },
    rw this, apply weak_dual.eval_continuous,
    exact continuous_induced_dom,
  end,
  continuous_cast_le := begin
    introsI c₁ c₂ h,
    rw continuous_induced_rng,
    exact continuous_induced_dom,
  end,
  ..(infer_instance : pseudo_normed_group (X.bdd_weak_dual p)) }

/-- The space of `p`-Radon measures on `X`, as a CompHaus-ly filtered pseudo normed group`. -/
def Radon_png : CompHausFiltPseuNormGrp₁ :=
{ M := X.bdd_weak_dual p,
  exhaustive' := λ μ, μ.2 }

/-- A continuous map of profinite spaces induces a morphism between `Radon_png p`. -/
def map_Radon_png {X Y : Profinite.{0}} (f : X ⟶ Y) :
  X.Radon_png p ⟶ Y.Radon_png p :=
{ to_fun := λ μ, ⟨weak_dual.comap f.comap μ.1, begin
    obtain ⟨c,hc⟩ := μ.2,
    use c,
    apply weak_dual.bdd_comap _ hc,
  end⟩,
  map_zero' := by { ext, refl },
  map_add' := λ a b, by { ext, refl },
  strict' := λ c μ hμ,
    weak_dual.bdd_comap _ hμ _,
  continuous' := begin
    intros c,
    rw continuous_induced_rng,
    let i1 : pseudo_normed_group.filtration ↥(X.Radon_png p) c →
      weak_dual _ _ := λ μ, μ.1.1,
    let i2 : weak_dual ℝ C(↥X, ℝ) → weak_dual ℝ C(↥Y, ℝ) :=
      weak_dual.comap (f.comap),
    change continuous (i2 ∘ i1),
    refine continuous.comp _ continuous_induced_dom,
    refine continuous_linear_map.continuous _,
  end }

/-- A functorial version of `Radon_png`. -/
def Radon_png_functor : Profinite.{0} ⥤ CompHausFiltPseuNormGrp₁ :=
{ obj := λ X, X.Radon_png p,
  map := λ X Y, map_Radon_png _,
  map_id' := λ X, by { ext, dsimp [map_Radon_png, weak_dual.comap], congr' 1,
    ext, refl },
  map_comp' := λ X Y Z f g, by { ext, refl } }

/-- The cone exhibiting `X.Radon_png p` as a limit of `T.Radon_png p` as
`T` varies over the discrete quotients of `X`. -/
def Radon_png_cone : cone (X.diagram ⋙ Radon_png_functor p) :=
(Radon_png_functor p).map_cone X.as_limit_cone

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_png_functor_level_iso_component (c : ℝ≥0) (X : Profinite.{0}) :
  (CompHausFiltPseuNormGrp₁.level.obj c).obj (X.Radon_png p) ≅
  (Radon_CompHaus_functor p c).obj X :=
let e := (bdd_weak_dual_filtration_homeo X p c) in
{ hom := e.to_continuous_map,
  inv := e.symm.to_continuous_map,
  hom_inv_id' := by { ext, refl },
  inv_hom_id' := by { ext, refl } }

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_png_functor_level_iso (c : ℝ≥0) :
  Radon_png_functor p ⋙ CompHausFiltPseuNormGrp₁.level.obj c ≅
  Radon_CompHaus_functor p c :=
nat_iso.of_components
(λ X, Radon_png_functor_level_iso_component _ _ _)
(λ X Y f, by { ext, refl })

/-- An auxiliary definition to be used in the constructions below. -/
def is_limit_Radon_png_cone_map_level (c : ℝ≥0) :
  is_limit ((Radon_png_functor p ⋙
    CompHausFiltPseuNormGrp₁.level.obj c).map_cone X.as_limit_cone) :=
{ lift := λ S,
    (X.is_limit_Radon_CompHaus_cone p c).lift
    ⟨_, S.π ≫ whisker_left _ (Radon_png_functor_level_iso p c).hom⟩ ≫
    (Radon_png_functor_level_iso p c).inv.app _,
  fac' := begin
    intros S j,
    erw [category.assoc, ← nat_trans.naturality,
      (X.is_limit_Radon_CompHaus_cone p c).fac_assoc],
    dsimp, simp only [category.assoc, iso.hom_inv_id_app],
    erw category.comp_id,
  end,
  uniq' := begin
    intros S m hm,
    rw [← nat_iso.app_inv, iso.eq_comp_inv],
    apply (X.is_limit_Radon_CompHaus_cone p c).hom_ext, intros j,
    erw (X.is_limit_Radon_CompHaus_cone p c).fac,
    dsimp, rw ← hm, dsimp, simp only [category.assoc],
    erw ← nat_trans.naturality,
  end }

/-- As promised, `X.Radon_png p` is a limit cone. -/
def is_limit_Radon_png_cone : is_limit (X.Radon_png_cone p) :=
CompHausFiltPseuNormGrp₁.level_jointly_reflects_limits _ $
λ c, is_limit_Radon_png_cone_map_level _ _ _

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_png_comparison_component (T : discrete_quotient X) :
  (X.diagram ⋙ Radon_png_functor p).obj T ≅
  (X.fintype_diagram ⋙ real_measures.functor p).obj T :=
CompHausFiltPseuNormGrp₁.create_iso_from_level.{0}
(λ c, Radon_png_functor_level_iso_component _ _ _ ≪≫
  (Radon_CompHaus_comparison _ _ _).app _)
begin
  ext, refl,
end
begin
  intros a b,
  ext, refl,
end begin
  intros c₁ c₂ i,
  ext, refl, -- ;-D
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_png_comparison :
  X.diagram ⋙ Radon_png_functor p ≅
  X.fintype_diagram ⋙ real_measures.functor p :=
nat_iso.of_components
(λ T, Radon_png_comparison_component _ _ _)
begin
  intros S T f,
  dsimp only [Radon_png_comparison_component, iso.trans_hom],
  apply CompHausFiltPseuNormGrp₁.level_jointly_faithful,
  intros c,
  simp only [functor.map_comp],
  simp_rw [CompHausFiltPseuNormGrp₁.level_create_iso_from_level.{0},
    iso.trans_hom, nat_iso.app_hom, category.assoc],
  erw ← (X.Radon_CompHaus_comparison p c).hom.naturality f,
  refl,
end

/-- The CompHaus-ly filtered pseudno normed group of signed `p`-Radon measures on `X`
is isomorphic to the limit of `real_measures p T` as `T` varies over
the discrete quotients of `X`.

This is the final key isomorphism needed for the comparison of Raon measures and
`ℳ_p(X)`. -/
def Radon_png_iso : X.Radon_png p ≅
  (Profinite.extend (real_measures.functor p)).obj X :=
(X.is_limit_Radon_png_cone p).cone_point_unique_up_to_iso
  (limit.is_limit _) ≪≫ has_limit.iso_of_nat_iso (X.Radon_png_comparison p)

end p_le_one

end p_pos

end Profinite


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.monoidal.braided
import category_theory.monoidal.Mon_

/-!
# The category of commutative monoids in a braided monoidal category.
-/

universes v₁ v₂ u₁ u₂

open category_theory
open category_theory.monoidal_category

variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C] [braided_category.{v₁} C]

/--
A commutative monoid object internal to a monoidal category.
-/
structure CommMon_ extends Mon_ C :=
(mul_comm' : (β_ _ _).hom ≫ mul = mul . obviously)

restate_axiom CommMon_.mul_comm'
attribute [simp, reassoc] CommMon_.mul_comm

namespace CommMon_

/--
The trivial commutative monoid object. We later show this is initial in `CommMon_ C`.
-/
@[simps]
def trivial : CommMon_ C :=
{ mul_comm' := begin dsimp, rw [braiding_left_unitor, unitors_equal], end
  ..Mon_.trivial C }

instance : inhabited (CommMon_ C) := ⟨trivial C⟩

variables {C} {M : CommMon_ C}

instance : category (CommMon_ C) :=
induced_category.category CommMon_.to_Mon_

@[simp] lemma id_hom (A : CommMon_ C) : Mon_.hom.hom (𝟙 A) = 𝟙 A.X := rfl
@[simp] lemma comp_hom {R S T : CommMon_ C} (f : R ⟶ S) (g : S ⟶ T) :
  Mon_.hom.hom (f ≫ g) = f.hom ≫ g.hom := rfl

section
variables (C)

/-- The forgetful functor from commutative monoid objects to monoid objects. -/
@[derive [full, faithful]]
def forget₂_Mon_ : CommMon_ C ⥤ Mon_ C :=
induced_functor CommMon_.to_Mon_

@[simp] lemma forget₂_Mon_obj_one (A : CommMon_ C) : ((forget₂_Mon_ C).obj A).one = A.one := rfl
@[simp] lemma forget₂_Mon_obj_mul (A : CommMon_ C) : ((forget₂_Mon_ C).obj A).mul = A.mul := rfl
@[simp] lemma forget₂_Mon_map_hom {A B : CommMon_ C} (f : A ⟶ B) :
  ((forget₂_Mon_ C).map f).hom = f.hom := rfl

end

instance unique_hom_from_trivial (A : CommMon_ C) : unique (trivial C ⟶ A) :=
Mon_.unique_hom_from_trivial A.to_Mon_

open category_theory.limits

instance : has_initial (CommMon_ C) :=
has_initial_of_unique (trivial C)

end CommMon_

namespace category_theory.lax_braided_functor

variables {C} {D : Type u₂} [category.{v₂} D] [monoidal_category.{v₂} D] [braided_category.{v₂} D]

/--
A lax braided functor takes commutative monoid objects to commutative monoid objects.

That is, a lax braided functor `F : C ⥤ D` induces a functor `CommMon_ C ⥤ CommMon_ D`.
-/
@[simps]
def map_CommMon (F : lax_braided_functor C D) : CommMon_ C ⥤ CommMon_ D :=
{ obj := λ A,
  { mul_comm' :=
    begin
      dsimp,
      have := F.braided,
      slice_lhs 1 2 { rw ←this, },
      slice_lhs 2 3 { rw [←category_theory.functor.map_comp, A.mul_comm], },
    end,
    ..F.to_lax_monoidal_functor.map_Mon.obj A.to_Mon_ },
  map := λ A B f, F.to_lax_monoidal_functor.map_Mon.map f, }

variables (C) (D)

/-- `map_CommMon` is functorial in the lax braided functor. -/
def map_CommMon_functor : (lax_braided_functor C D) ⥤ (CommMon_ C ⥤ CommMon_ D) :=
{ obj := map_CommMon,
  map := λ F G α,
  { app := λ A,
    { hom := α.app A.X, } } }

end category_theory.lax_braided_functor

namespace CommMon_

open category_theory.lax_braided_functor

namespace equiv_lax_braided_functor_punit

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def lax_braided_to_CommMon : lax_braided_functor (discrete punit) C ⥤ CommMon_ C :=
{ obj := λ F, (F.map_CommMon : CommMon_ _ ⥤ CommMon_ C).obj (trivial (discrete punit)),
  map := λ F G α, ((map_CommMon_functor (discrete punit) C).map α).app _ }

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def CommMon_to_lax_braided : CommMon_ C ⥤ lax_braided_functor (discrete punit) C :=
{ obj := λ A,
  { obj := λ _, A.X,
    map := λ _ _ _, 𝟙 _,
    ε := A.one,
    μ := λ _ _, A.mul,
    map_id' := λ _, rfl,
    map_comp' := λ _ _ _ _ _, (category.id_comp (𝟙 A.X)).symm, },
  map := λ A B f,
  { app := λ _, f.hom,
    naturality' := λ _ _ _, by { dsimp, rw [category.id_comp, category.comp_id], },
    unit' := f.one_hom,
    tensor' := λ _ _, f.mul_hom, }, }

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def unit_iso :
  𝟭 (lax_braided_functor (discrete punit) C) ≅
    lax_braided_to_CommMon C ⋙ CommMon_to_lax_braided C :=
nat_iso.of_components (λ F, lax_braided_functor.mk_iso
  (monoidal_nat_iso.of_components
    (λ _, F.to_lax_monoidal_functor.to_functor.map_iso (eq_to_iso (by ext)))
    (by tidy) (by tidy) (by tidy)))
  (by tidy)

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def counit_iso : CommMon_to_lax_braided C ⋙ lax_braided_to_CommMon C ≅ 𝟭 (CommMon_ C) :=
nat_iso.of_components (λ F, { hom := { hom := 𝟙 _, }, inv := { hom := 𝟙 _, } })
  (by tidy)

end equiv_lax_braided_functor_punit

open equiv_lax_braided_functor_punit

/--
Commutative monoid objects in `C` are "just" braided lax monoidal functors from the trivial
braided monoidal category to `C`.
-/
@[simps]
def equiv_lax_braided_functor_punit : lax_braided_functor (discrete punit) C ≌ CommMon_ C :=
{ functor := lax_braided_to_CommMon C,
  inverse := CommMon_to_lax_braided C,
  unit_iso := unit_iso C,
  counit_iso := counit_iso C, }

end CommMon_


example (x : ℕ) : x = x :=
begin
  revert x,
  intro y,
  reflexivity
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.uniform_space.cauchy
import Mathlib.topology.uniform_space.separation
import Mathlib.topology.dense_embedding
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Theory of complete separated uniform spaces.

This file is for elementary lemmas that depend on both Cauchy filters and separation.
-/

/-In a separated space, a complete set is closed -/

theorem is_complete.is_closed {α : Type u_1} [uniform_space α] [separated_space α] {s : set α} (h : is_complete s) : is_closed s := sorry

namespace dense_inducing

theorem continuous_extend_of_cauchy {α : Type u_1} [topological_space α] {β : Type u_2} [topological_space β] {γ : Type u_3} [uniform_space γ] [complete_space γ] [separated_space γ] {e : α → β} {f : α → γ} (de : dense_inducing e) (h : ∀ (b : β), cauchy (filter.map f (filter.comap e (nhds b)))) : continuous (extend de f) :=
  continuous_extend de fun (b : β) => complete_space.complete (h b)


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison
-/
import category_theory.eq_to_hom

/-!
# Cartesian products of categories

We define the category instance on `C × D` when `C` and `D` are categories.

We define:
* `sectl C Z` : the functor `C ⥤ C × D` given by `X ↦ ⟨X, Z⟩`
* `sectr Z D` : the functor `D ⥤ C × D` given by `Y ↦ ⟨Z, Y⟩`
* `fst`       : the functor `⟨X, Y⟩ ↦ X`
* `snd`       : the functor `⟨X, Y⟩ ↦ Y`
* `swap`      : the functor `C × D ⥤ D × C` given by `⟨X, Y⟩ ↦ ⟨Y, X⟩`
    (and the fact this is an equivalence)

We further define `evaluation : C ⥤ (C ⥤ D) ⥤ D` and `evaluation_uncurried : C × (C ⥤ D) ⥤ D`,
and products of functors and natural transformations, written `F.prod G` and `α.prod β`.
-/

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

/--
`prod C D` gives the cartesian product of two categories.

See <https://stacks.math.columbia.edu/tag/001K>.
-/
@[simps {not_recursive := []}] -- the generates simp lemmas like `id_fst` and `comp_snd`
instance prod : category.{max v₁ v₂} (C × D) :=
{ hom     := λ X Y, ((X.1) ⟶ (Y.1)) × ((X.2) ⟶ (Y.2)),
  id      := λ X, ⟨ 𝟙 (X.1), 𝟙 (X.2) ⟩,
  comp    := λ _ _ _ f g, (f.1 ≫ g.1, f.2 ≫ g.2) }

/-- Two rfl lemmas that cannot be generated by `@[simps]`. -/
@[simp]

lemma is_iso_prod_iff {P Q : C} {S T : D} {f : (P, S) ⟶ (Q, T)} :
  is_iso f ↔ is_iso f.1 ∧ is_iso f.2 :=
begin
  split,
  { rintros ⟨g, hfg, hgf⟩,
    simp at hfg hgf,
    rcases hfg with ⟨hfg₁, hfg₂⟩,
    rcases hgf with ⟨hgf₁, hgf₂⟩,
    exact ⟨⟨⟨g.1, hfg₁, hgf₁⟩⟩, ⟨⟨g.2, hfg₂, hgf₂⟩⟩⟩ },
  { rintros ⟨⟨g₁, hfg₁, hgf₁⟩, ⟨g₂, hfg₂, hgf₂⟩⟩,
    dsimp at hfg₁ hgf₁ hfg₂ hgf₂,
    refine ⟨⟨(g₁, g₂), _, _⟩⟩; { simp; split; assumption } }
end

section
variables {C D}

/-- Construct an isomorphism in `C × D` out of two isomorphisms in `C` and `D`. -/
@[simps]
def iso.prod {P Q : C} {S T : D} (f : P ≅ Q) (g : S ≅ T) : (P, S) ≅ (Q, T) :=
{ hom := (f.hom, g.hom),
  inv := (f.inv, g.inv), }

end

end

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₁) [category.{v₁} D]
/--
`prod.category.uniform C D` is an additional instance specialised so both factors have the same
universe levels. This helps typeclass resolution.
-/
instance uniform_prod : category (C × D) := category_theory.prod C D
end

-- Next we define the natural functors into and out of product categories. For now this doesn't
-- address the universal properties.
namespace prod

/-- `sectl C Z` is the functor `C ⥤ C × D` given by `X ↦ (X, Z)`. -/
@[simps] def sectl
  (C : Type u₁) [category.{v₁} C] {D : Type u₂} [category.{v₂} D] (Z : D) : C ⥤ C × D :=
{ obj := λ X, (X, Z),
  map := λ X Y f, (f, 𝟙 Z) }

/-- `sectr Z D` is the functor `D ⥤ C × D` given by `Y ↦ (Z, Y)` . -/
@[simps] def sectr
  {C : Type u₁} [category.{v₁} C] (Z : C) (D : Type u₂) [category.{v₂} D] : D ⥤ C × D :=
{ obj := λ X, (Z, X),
  map := λ X Y f, (𝟙 Z, f) }

variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

/-- `fst` is the functor `(X, Y) ↦ X`. -/
@[simps] def fst : C × D ⥤ C :=
{ obj := λ X, X.1,
  map := λ X Y f, f.1 }

/-- `snd` is the functor `(X, Y) ↦ Y`. -/
@[simps] def snd : C × D ⥤ D :=
{ obj := λ X, X.2,
  map := λ X Y f, f.2 }

/-- The functor swapping the factors of a cartesian product of categories, `C × D ⥤ D × C`. -/
@[simps] def swap : C × D ⥤ D × C :=
{ obj := λ X, (X.2, X.1),
  map := λ _ _ f, (f.2, f.1) }

/--
Swapping the factors of a cartesion product of categories twice is naturally isomorphic
to the identity functor.
-/
@[simps] def symmetry : swap C D ⋙ swap D C ≅ 𝟭 (C × D) :=
{ hom := { app := λ X, 𝟙 X },
  inv := { app := λ X, 𝟙 X } }

/--
The equivalence, given by swapping factors, between `C × D` and `D × C`.
-/
@[simps]
def braiding : C × D ≌ D × C :=
equivalence.mk (swap C D) (swap D C)
  (nat_iso.of_components (λ X, eq_to_iso (by simp)) (by tidy))
  (nat_iso.of_components (λ X, eq_to_iso (by simp)) (by tidy))

instance swap_is_equivalence : is_equivalence (swap C D) :=
(by apply_instance : is_equivalence (braiding C D).functor)

end prod

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D]

/--
The "evaluation at `X`" functor, such that
`(evaluation.obj X).obj F = F.obj X`,
which is functorial in both `X` and `F`.
-/
@[simps] def evaluation : C ⥤ (C ⥤ D) ⥤ D :=
{ obj := λ X,
  { obj := λ F, F.obj X,
    map := λ F G α, α.app X, },
  map := λ X Y f,
  { app := λ F, F.map f,
    naturality' := λ F G α, eq.symm (α.naturality f) } }

/--
The "evaluation of `F` at `X`" functor,
as a functor `C × (C ⥤ D) ⥤ D`.
-/
@[simps] def evaluation_uncurried : C × (C ⥤ D) ⥤ D :=
{ obj := λ p, p.2.obj p.1,
  map := λ x y f, (x.2.map f.1) ≫ (f.2.app y.1),
  map_comp' := λ X Y Z f g,
  begin
    cases g, cases f, cases Z, cases Y, cases X,
    simp only [prod_comp, nat_trans.comp_app, functor.map_comp, category.assoc],
    rw [←nat_trans.comp_app, nat_trans.naturality, nat_trans.comp_app,
        category.assoc, nat_trans.naturality],
  end }

end

variables {A : Type u₁} [category.{v₁} A]
          {B : Type u₂} [category.{v₂} B]
          {C : Type u₃} [category.{v₃} C]
          {D : Type u₄} [category.{v₄} D]

namespace functor
/-- The cartesian product of two functors. -/
@[simps] def prod (F : A ⥤ B) (G : C ⥤ D) : A × C ⥤ B × D :=
{ obj := λ X, (F.obj X.1, G.obj X.2),
  map := λ _ _ f, (F.map f.1, G.map f.2) }

/- Because of limitations in Lean 3's handling of notations, we do not setup a notation `F × G`.
   You can use `F.prod G` as a "poor man's infix", or just write `functor.prod F G`. -/

/-- Similar to `prod`, but both functors start from the same category `A` -/
@[simps] def prod' (F : A ⥤ B) (G : A ⥤ C) : A ⥤ (B × C) :=
{ obj := λ a, (F.obj a, G.obj a),
  map := λ x y f, (F.map f, G.map f), }

section
variable (C)

/-- The diagonal functor. -/
def diag : C ⥤ C × C := (𝟭 C).prod' (𝟭 C)

@[simp] lemma diag_obj (X : C) : (diag C).obj X = (X, X) := rfl

@[simp] lemma diag_map {X Y : C} (f : X ⟶ Y) : (diag C).map f = (f, f) := rfl

end

end functor

namespace nat_trans

/-- The cartesian product of two natural transformations. -/
@[simps] def prod {F G : A ⥤ B} {H I : C ⥤ D} (α : F ⟶ G) (β : H ⟶ I) :
  F.prod H ⟶ G.prod I :=
{ app         := λ X, (α.app X.1, β.app X.2),
  naturality' := λ X Y f,
  begin
    cases X, cases Y,
    simp only [functor.prod_map, prod.mk.inj_iff, prod_comp],
    split; rw naturality
  end }

/- Again, it is inadvisable in Lean 3 to setup a notation `α × β`;
   use instead `α.prod β` or `nat_trans.prod α β`. -/

end nat_trans

/-- `F.flip` composed with evaluation is the same as evaluating `F`. -/
@[simps]
def flip_comp_evaluation (F : A ⥤ B ⥤ C) (a) :
  F.flip ⋙ (evaluation _ _).obj a ≅ F.obj a :=
nat_iso.of_components (λ b, eq_to_iso rfl) $ by tidy

end category_theory