/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Nicolò Cavalleri
-/
import topology.algebra.module
import topology.continuous_function.basic
import algebra.algebra.subalgebra
import tactic.field_simp

/-!
# Algebraic structures over continuous functions

In this file we define instances of algebraic structures over the type `continuous_map α β`
(denoted `C(α, β)`) of **bundled** continuous maps from `α` to `β`. For example, `C(α, β)`
is a group when `β` is a group, a ring when `β` is a ring, etc.

For each type of algebraic structure, we also define an appropriate subobject of `α → β`
with carrier `{ f : α → β | continuous f }`. For example, when `β` is a group, a subgroup
`continuous_subgroup α β` of `α → β` is constructed with carrier `{ f : α → β | continuous f }`.

Note that, rather than using the derived algebraic structures on these subobjects
(for example, when `β` is a group, the derived group structure on `continuous_subgroup α β`),
one should use `C(α, β)` with the appropriate instance of the structure.
-/

local attribute [elab_simple] continuous.comp

namespace continuous_functions

variables {α : Type*} {β : Type*} [topological_space α] [topological_space β]
variables {f g : {f : α → β | continuous f }}

instance : has_coe_to_fun {f : α → β | continuous f} (λ _, α → β) :=  ⟨subtype.val⟩

end continuous_functions

namespace continuous_map
variables {α : Type*} {β : Type*} [topological_space α] [topological_space β]

@[to_additive]
instance has_mul [has_mul β] [has_continuous_mul β] : has_mul C(α, β) :=
⟨λ f g, ⟨f * g, continuous_mul.comp (f.continuous.prod_mk g.continuous : _)⟩⟩

@[simp, norm_cast, to_additive]
lemma coe_mul [has_mul β] [has_continuous_mul β] (f g : C(α, β)) :
  ((f * g : C(α, β)) : α → β) = (f : α → β) * (g : α → β) := rfl

@[to_additive]
instance [has_one β] : has_one C(α, β) := ⟨const (1 : β)⟩

@[simp, norm_cast, to_additive]
lemma coe_one [has_one β]  :
  ((1 : C(α, β)) : α → β) = (1 : α → β) := rfl

@[simp, to_additive] lemma mul_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [semigroup γ] [has_continuous_mul γ] (f₁ f₂ : C(β, γ)) (g : C(α, β)) :
  (f₁ * f₂).comp g = f₁.comp g * f₂.comp g :=
by { ext, simp, }

@[simp, to_additive] lemma one_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ] [has_one γ] (g : C(α, β)) :
  (1 : C(β, γ)).comp g = 1 :=
by { ext, simp, }

end continuous_map

section group_structure

/-!
### Group stucture

In this section we show that continuous functions valued in a topological group inherit
the structure of a group.
-/

section subtype

/-- The `submonoid` of continuous maps `α → β`. -/
@[to_additive "The `add_submonoid` of continuous maps `α → β`. "]
def continuous_submonoid (α : Type*) (β : Type*) [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] : submonoid (α → β) :=
{ carrier := { f : α → β | continuous f },
  one_mem' := @continuous_const _ _ _ _ 1,
  mul_mem' := λ f g fc gc, continuous.comp
    has_continuous_mul.continuous_mul (continuous.prod_mk fc gc : _) }

/-- The subgroup of continuous maps `α → β`. -/
@[to_additive "The `add_subgroup` of continuous maps `α → β`. "]
def continuous_subgroup (α : Type*) (β : Type*) [topological_space α] [topological_space β]
  [group β] [topological_group β] : subgroup (α → β) :=
{ inv_mem' := λ f fc, continuous.comp (@topological_group.continuous_inv β _ _ _) fc,
  ..continuous_submonoid α β, }.

end subtype

namespace continuous_map

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [semigroup β] [has_continuous_mul β] : semigroup C(α, β) :=
{ mul_assoc := λ a b c, by ext; exact mul_assoc _ _ _,
  ..continuous_map.has_mul}

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] : monoid C(α, β) :=
{ one_mul := λ a, by ext; exact one_mul _,
  mul_one := λ a, by ext; exact mul_one _,
  ..continuous_map.semigroup,
  ..continuous_map.has_one }

/-- Coercion to a function as an `monoid_hom`. Similar to `monoid_hom.coe_fn`. -/
@[to_additive "Coercion to a function as an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn`.",
  simps]
def coe_fn_monoid_hom {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] : C(α, β) →* (α → β) :=
{ to_fun := coe_fn, map_one' := coe_one, map_mul' := coe_mul }

/-- Composition on the left by a (continuous) homomorphism of topological monoids, as a
`monoid_hom`. Similar to `monoid_hom.comp_left`. -/
@[to_additive "Composition on the left by a (continuous) homomorphism of topological `add_monoid`s,
as an `add_monoid_hom`. Similar to `add_monoid_hom.comp_left`.", simps]
protected def _root_.monoid_hom.comp_left_continuous (α : Type*) {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [monoid β] [has_continuous_mul β]
  [topological_space γ] [monoid γ] [has_continuous_mul γ] (g : β →* γ) (hg : continuous g)  :
  C(α, β) →* C(α, γ) :=
{ to_fun := λ f, (⟨g, hg⟩ : C(β, γ)).comp f,
  map_one' := ext $ λ x, g.map_one,
  map_mul' := λ f₁ f₂, ext $ λ x, g.map_mul _ _ }

/-- Composition on the right as a `monoid_hom`. Similar to `monoid_hom.comp_hom'`. -/
@[to_additive "Composition on the right as an `add_monoid_hom`. Similar to
`add_monoid_hom.comp_hom'`.", simps]
def comp_monoid_hom' {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [monoid γ] [has_continuous_mul γ] (g : C(α, β)) : C(β, γ) →* C(α, γ) :=
{ to_fun := λ f, f.comp g, map_one' := one_comp g, map_mul' := λ f₁ f₂, mul_comp f₁ f₂ g }

@[simp, norm_cast]
lemma coe_pow {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] (f : C(α, β)) (n : ℕ) :
  ((f^n : C(α, β)) : α → β) = (f : α → β)^n :=
(coe_fn_monoid_hom : C(α, β) →* _).map_pow f n

@[simp] lemma pow_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [monoid γ] [has_continuous_mul γ] (f : C(β, γ)) (n : ℕ) (g : C(α, β)) :
  (f^n).comp g = (f.comp g)^n :=
(comp_monoid_hom' g).map_pow f n

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
[topological_space β] [comm_monoid β] [has_continuous_mul β] : comm_monoid C(α, β) :=
{ one_mul := λ a, by ext; exact one_mul _,
  mul_one := λ a, by ext; exact mul_one _,
  mul_comm := λ a b, by ext; exact mul_comm _ _,
  ..continuous_map.semigroup,
  ..continuous_map.has_one }

open_locale big_operators
@[simp, to_additive] lemma coe_prod {α : Type*} {β : Type*} [comm_monoid β]
  [topological_space α] [topological_space β] [has_continuous_mul β]
  {ι : Type*} (s : finset ι) (f : ι → C(α, β)) :
  ⇑(∏ i in s, f i) = (∏ i in s, (f i : α → β)) :=
(coe_fn_monoid_hom : C(α, β) →* _).map_prod f s

@[to_additive]
lemma prod_apply {α : Type*} {β : Type*} [comm_monoid β]
  [topological_space α] [topological_space β] [has_continuous_mul β]
  {ι : Type*} (s : finset ι) (f : ι → C(α, β)) (a : α) :
  (∏ i in s, f i) a = (∏ i in s, f i a) :=
by simp

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [group β] [topological_group β] : group C(α, β) :=
{ inv := λ f, ⟨λ x, (f x)⁻¹, continuous_inv.comp f.continuous⟩,
  mul_left_inv := λ a, by ext; exact mul_left_inv _,
  ..continuous_map.monoid }

@[simp, norm_cast, to_additive]
lemma coe_inv {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [group β] [topological_group β] (f : C(α, β)) :
  ((f⁻¹ : C(α, β)) : α → β) = (f⁻¹ : α → β) :=
rfl

@[simp, norm_cast, to_additive]
lemma coe_div {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [group β] [topological_group β] (f g : C(α, β)) :
  ((f / g : C(α, β)) : α → β) = (f : α → β) / (g : α → β) :=
by { simp only [div_eq_mul_inv], refl, }

@[simp, to_additive] lemma inv_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [group γ] [topological_group γ] (f : C(β, γ)) (g : C(α, β)) :
  (f⁻¹).comp g = (f.comp g)⁻¹ :=
by { ext, simp, }

@[simp, to_additive] lemma div_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [group γ] [topological_group γ] (f g : C(β, γ)) (h : C(α, β)) :
  (f / g).comp h = (f.comp h) / (g.comp h) :=
by { ext, simp, }

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_group β] [topological_group β] : comm_group C(α, β) :=
{ ..continuous_map.group,
  ..continuous_map.comm_monoid }

end continuous_map

end group_structure

section ring_structure

/-!
### Ring stucture

In this section we show that continuous functions valued in a topological ring `R` inherit
the structure of a ring.
-/

section subtype

/-- The subsemiring of continuous maps `α → β`. -/
def continuous_subsemiring (α : Type*) (R : Type*) [topological_space α] [topological_space R]
  [semiring R] [topological_ring R] : subsemiring (α → R) :=
{ ..continuous_add_submonoid α R,
  ..continuous_submonoid α R }.

/-- The subring of continuous maps `α → β`. -/
def continuous_subring (α : Type*) (R : Type*) [topological_space α] [topological_space R]
  [ring R] [topological_ring R] : subring (α → R) :=
{ ..continuous_subsemiring α R,
  ..continuous_add_subgroup α R }.

end subtype

namespace continuous_map

instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [semiring β] [topological_ring β] : semiring C(α, β) :=
{ left_distrib := λ a b c, by ext; exact left_distrib _ _ _,
  right_distrib := λ a b c, by ext; exact right_distrib _ _ _,
  zero_mul := λ a, by ext; exact zero_mul _,
  mul_zero := λ a, by ext; exact mul_zero _,
  ..continuous_map.add_comm_monoid,
  ..continuous_map.monoid }

instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [ring β] [topological_ring β] : ring C(α, β) :=
{ ..continuous_map.semiring,
  ..continuous_map.add_comm_group, }

instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_ring β] [topological_ring β] : comm_ring C(α, β) :=
{ ..continuous_map.semiring,
  ..continuous_map.add_comm_group,
  ..continuous_map.comm_monoid,}

/-- Composition on the left by a (continuous) homomorphism of topological rings, as a `ring_hom`.
Similar to `ring_hom.comp_left`. -/
@[simps] protected def _root_.ring_hom.comp_left_continuous (α : Type*) {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [semiring β] [topological_ring β]
  [topological_space γ] [semiring γ] [topological_ring γ] (g : β →+* γ) (hg : continuous g) :
  C(α, β) →+* C(α, γ) :=
{ .. g.to_monoid_hom.comp_left_continuous α hg,
  .. g.to_add_monoid_hom.comp_left_continuous α hg }

/-- Coercion to a function as a `ring_hom`. -/
@[simps]
def coe_fn_ring_hom {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [ring β] [topological_ring β] : C(α, β) →+* (α → β) :=
{ to_fun := coe_fn,
  ..(coe_fn_monoid_hom : C(α, β) →* _),
  ..(coe_fn_add_monoid_hom : C(α, β) →+ _) }

end continuous_map

end ring_structure

local attribute [ext] subtype.eq

section module_structure

/-!
### Semiodule stucture

In this section we show that continuous functions valued in a topological module `M` over a
topological semiring `R` inherit the structure of a module.
-/

section subtype

variables (α : Type*) [topological_space α]
variables (R : Type*) [semiring R] [topological_space R]
variables (M : Type*) [topological_space M] [add_comm_group M]
variables [module R M] [has_continuous_smul R M] [topological_add_group M]

/-- The `R`-submodule of continuous maps `α → M`. -/
def continuous_submodule : submodule R (α → M) :=
{ carrier := { f : α → M | continuous f },
  smul_mem' := λ c f hf, continuous_smul.comp
    (continuous.prod_mk (continuous_const : continuous (λ x, c)) hf),
  ..continuous_add_subgroup α M }

end subtype

namespace continuous_map
variables {α : Type*} [topological_space α]
  {R : Type*} [semiring R] [topological_space R]
  {M : Type*} [topological_space M] [add_comm_monoid M]
  {M₂ : Type*} [topological_space M₂] [add_comm_monoid M₂]

instance
  [module R M] [has_continuous_smul R M] :
  has_scalar R C(α, M) :=
⟨λ r f, ⟨r • f, f.continuous.const_smul r⟩⟩

@[simp, norm_cast]
lemma coe_smul [module R M] [has_continuous_smul R M]
  (c : R) (f : C(α, M)) : ⇑(c • f) = c • f := rfl

lemma smul_apply [module R M] [has_continuous_smul R M]
  (c : R) (f : C(α, M)) (a : α) : (c • f) a = c • (f a) :=
by simp

@[simp] lemma smul_comp {α : Type*} {β : Type*}
  [topological_space α] [topological_space β]
   [module R M] [has_continuous_smul R M] (r : R) (f : C(β, M)) (g : C(α, β)) :
  (r • f).comp g = r • (f.comp g) :=
by { ext, simp, }

variables [has_continuous_add M] [module R M] [has_continuous_smul R M]
variables [has_continuous_add M₂] [module R M₂] [has_continuous_smul R M₂]

instance module : module R C(α, M) :=
{ smul     := (•),
  smul_add := λ c f g, by { ext, exact smul_add c (f x) (g x) },
  add_smul := λ c₁ c₂ f, by { ext, exact add_smul c₁ c₂ (f x) },
  mul_smul := λ c₁ c₂ f, by { ext, exact mul_smul c₁ c₂ (f x) },
  one_smul := λ f, by { ext, exact one_smul R (f x) },
  zero_smul := λ f, by { ext, exact zero_smul _ _ },
  smul_zero := λ r, by { ext, exact smul_zero _ } }

variables (R)

/-- Composition on the left by a continuous linear map, as a `linear_map`.
Similar to `linear_map.comp_left`. -/
@[simps] protected def _root_.continuous_linear_map.comp_left_continuous (α : Type*)
  [topological_space α] (g : M →L[R] M₂) :
  C(α, M) →ₗ[R] C(α, M₂) :=
{ map_smul' := λ c f, ext $ λ x, g.map_smul' c _,
  .. g.to_linear_map.to_add_monoid_hom.comp_left_continuous α g.continuous }

/-- Coercion to a function as a `linear_map`. -/
@[simps]
def coe_fn_linear_map : C(α, M) →ₗ[R] (α → M) :=
{ to_fun := coe_fn,
  map_smul' := coe_smul,
  ..(coe_fn_add_monoid_hom : C(α, M) →+ _) }

end continuous_map

end module_structure

section algebra_structure

/-!
### Algebra structure

In this section we show that continuous functions valued in a topological algebra `A` over a ring
`R` inherit the structure of an algebra. Note that the hypothesis that `A` is a topological algebra
is obtained by requiring that `A` be both a `has_continuous_smul` and a `topological_ring`.-/

section subtype

variables {α : Type*} [topological_space α]
{R : Type*} [comm_semiring R]
{A : Type*} [topological_space A] [semiring A]
[algebra R A] [topological_ring A]

/-- The `R`-subalgebra of continuous maps `α → A`. -/
def continuous_subalgebra : subalgebra R (α → A) :=
{ carrier := { f : α → A | continuous f },
  algebra_map_mem' := λ r, (continuous_const : continuous $ λ (x : α), algebra_map R A r),
  ..continuous_subsemiring α A }

end subtype

section continuous_map

variables {α : Type*} [topological_space α]
{R : Type*} [comm_semiring R]
{A : Type*} [topological_space A] [semiring A]
[algebra R A] [topological_ring A]
{A₂ : Type*} [topological_space A₂] [semiring A₂]
[algebra R A₂] [topological_ring A₂]

/-- Continuous constant functions as a `ring_hom`. -/
def continuous_map.C : R →+* C(α, A) :=
{ to_fun    := λ c : R, ⟨λ x: α, ((algebra_map R A) c), continuous_const⟩,
  map_one'  := by ext x; exact (algebra_map R A).map_one,
  map_mul'  := λ c₁ c₂, by ext x; exact (algebra_map R A).map_mul _ _,
  map_zero' := by ext x; exact (algebra_map R A).map_zero,
  map_add'  := λ c₁ c₂, by ext x; exact (algebra_map R A).map_add _ _ }

@[simp] lemma continuous_map.C_apply (r : R) (a : α) : continuous_map.C r a = algebra_map R A r :=
rfl

variables [topological_space R] [has_continuous_smul R A] [has_continuous_smul R A₂]

instance continuous_map.algebra : algebra R C(α, A) :=
{ to_ring_hom := continuous_map.C,
  commutes' := λ c f, by ext x; exact algebra.commutes' _ _,
  smul_def' := λ c f, by ext x; exact algebra.smul_def' _ _, }

variables (R)

/-- Composition on the left by a (continuous) homomorphism of topological `R`-algebras, as an
`alg_hom`. Similar to `alg_hom.comp_left`. -/
@[simps] protected def alg_hom.comp_left_continuous {α : Type*} [topological_space α]
  (g : A →ₐ[R] A₂) (hg : continuous g) :
  C(α, A) →ₐ[R] C(α, A₂) :=
{ commutes' := λ c, continuous_map.ext $ λ _, g.commutes' _,
  .. g.to_ring_hom.comp_left_continuous α hg }

/-- Coercion to a function as an `alg_hom`. -/
@[simps]
def continuous_map.coe_fn_alg_hom : C(α, A) →ₐ[R] (α → A) :=
{ to_fun := coe_fn,
  commutes' := λ r, rfl,
  -- `..(continuous_map.coe_fn_ring_hom : C(α, A) →+* _)` times out for some reason
  map_zero' := continuous_map.coe_zero,
  map_one' := continuous_map.coe_one,
  map_add' := continuous_map.coe_add,
  map_mul' := continuous_map.coe_mul }

instance: is_scalar_tower R A C(α, A) :=
{ smul_assoc := λ _ _ _, by { ext, simp } }

variables {R}

/--
A version of `separates_points` for subalgebras of the continuous functions,
used for stating the Stone-Weierstrass theorem.
-/
abbreviation subalgebra.separates_points (s : subalgebra R C(α, A)) : Prop :=
set.separates_points ((λ f : C(α, A), (f : α → A)) '' (s : set C(α, A)))

lemma subalgebra.separates_points_monotone :
  monotone (λ s : subalgebra R C(α, A), s.separates_points) :=
λ s s' r h x y n,
begin
  obtain ⟨f, m, w⟩ := h n,
  rcases m with ⟨f, ⟨m, rfl⟩⟩,
  exact ⟨_, ⟨f, ⟨r m, rfl⟩⟩, w⟩,
end

@[simp] lemma algebra_map_apply (k : R) (a : α) :
  algebra_map R C(α, A) k a = k • 1 :=
by { rw algebra.algebra_map_eq_smul_one, refl, }

variables {𝕜 : Type*} [topological_space 𝕜]

/--
A set of continuous maps "separates points strongly"
if for each pair of distinct points there is a function with specified values on them.

We give a slightly unusual formulation, where the specified values are given by some
function `v`, and we ask `f x = v x ∧ f y = v y`. This avoids needing a hypothesis `x ≠ y`.

In fact, this definition would work perfectly well for a set of non-continuous functions,
but as the only current use case is in the Stone-Weierstrass theorem,
writing it this way avoids having to deal with casts inside the set.
(This may need to change if we do Stone-Weierstrass on non-compact spaces,
where the functions would be continuous functions vanishing at infinity.)
-/
def set.separates_points_strongly (s : set C(α, 𝕜)) : Prop :=
∀ (v : α → 𝕜) (x y : α), ∃ f : s, (f x : 𝕜) = v x ∧ f y = v y

variables [field 𝕜] [topological_ring 𝕜]

/--
Working in continuous functions into a topological field,
a subalgebra of functions that separates points also separates points strongly.

By the hypothesis, we can find a function `f` so `f x ≠ f y`.
By an affine transformation in the field we can arrange so that `f x = a` and `f x = b`.
-/
lemma subalgebra.separates_points.strongly {s : subalgebra 𝕜 C(α, 𝕜)} (h : s.separates_points) :
  (s : set C(α, 𝕜)).separates_points_strongly :=
λ v x y,
begin
  by_cases n : x = y,
  { subst n,
    use ((v x) • 1 : C(α, 𝕜)),
    { apply s.smul_mem,
      apply s.one_mem, },
    { simp [coe_fn_coe_base'] }, },
  obtain ⟨f, ⟨f, ⟨m, rfl⟩⟩, w⟩ := h n,
  replace w : f x - f y ≠ 0 := sub_ne_zero_of_ne w,
  let a := v x,
  let b := v y,
  let f' := ((b - a) * (f x - f y)⁻¹) • (continuous_map.C (f x) - f) + continuous_map.C a,
  refine ⟨⟨f', _⟩, _, _⟩,
  { simp only [f', set_like.mem_coe, subalgebra.mem_to_submodule],
    -- TODO should there be a tactic for this?
    -- We could add an attribute `@[subobject_mem]`, and a tactic
    -- ``def subobject_mem := `[solve_by_elim with subobject_mem { max_depth := 10 }]``
    solve_by_elim
      [subalgebra.add_mem, subalgebra.smul_mem, subalgebra.sub_mem, subalgebra.algebra_map_mem]
      { max_depth := 6 }, },
  { simp [f', coe_fn_coe_base'], },
  { simp [f', coe_fn_coe_base', inv_mul_cancel_right₀ w], },
end

end continuous_map

-- TODO[gh-6025]: make this an instance once safe to do so
lemma continuous_map.subsingleton_subalgebra (α : Type*) [topological_space α]
  (R : Type*) [comm_semiring R] [topological_space R] [topological_ring R]
  [subsingleton α] : subsingleton (subalgebra R C(α, R)) :=
begin
  fsplit,
  intros s₁ s₂,
  by_cases n : nonempty α,
  { obtain ⟨x⟩ := n,
    ext f,
    have h : f = algebra_map R C(α, R) (f x),
    { ext x', simp only [mul_one, algebra.id.smul_eq_mul, algebra_map_apply], congr, },
    rw h,
    simp only [subalgebra.algebra_map_mem], },
  { ext f,
    have h : f = 0,
    { ext x', exact false.elim (n ⟨x'⟩), },
    subst h,
    simp only [subalgebra.zero_mem], },
end

end algebra_structure

section module_over_continuous_functions

/-!
### Structure as module over scalar functions

If `M` is a module over `R`, then we show that the space of continuous functions from `α` to `M`
is naturally a module over the ring of continuous functions from `α` to `R`. -/

namespace continuous_map

instance has_scalar' {α : Type*} [topological_space α]
  {R : Type*} [semiring R] [topological_space R]
  {M : Type*} [topological_space M] [add_comm_monoid M]
  [module R M] [has_continuous_smul R M] :
  has_scalar C(α, R) C(α, M) :=
⟨λ f g, ⟨λ x, (f x) • (g x), (continuous.smul f.2 g.2)⟩⟩

instance module' {α : Type*} [topological_space α]
  (R : Type*) [ring R] [topological_space R] [topological_ring R]
  (M : Type*) [topological_space M] [add_comm_monoid M] [has_continuous_add M]
  [module R M] [has_continuous_smul R M] :
  module C(α, R) C(α, M) :=
{ smul     := (•),
  smul_add := λ c f g, by ext x; exact smul_add (c x) (f x) (g x),
  add_smul := λ c₁ c₂ f, by ext x; exact add_smul (c₁ x) (c₂ x) (f x),
  mul_smul := λ c₁ c₂ f, by ext x; exact mul_smul (c₁ x) (c₂ x) (f x),
  one_smul := λ f, by ext x; exact one_smul R (f x),
  zero_smul := λ f, by ext x; exact zero_smul _ _,
  smul_zero := λ r, by ext x; exact smul_zero _, }

end continuous_map

end module_over_continuous_functions

/-!
We now provide formulas for `f ⊓ g` and `f ⊔ g`, where `f g : C(α, β)`,
in terms of `continuous_map.abs`.
-/

section
variables {R : Type*} [linear_ordered_field R]

-- TODO:
-- This lemma (and the next) could go all the way back in `algebra.order.field`,
-- except that it is tedious to prove without tactics.
-- Rather than stranding it at some intermediate location,
-- it's here, immediately prior to the point of use.
lemma min_eq_half_add_sub_abs_sub {x y : R} : min x y = 2⁻¹ * (x + y - |x - y|) :=
by cases le_total x y with h h; field_simp [h, abs_of_nonneg, abs_of_nonpos, mul_two]; abel

lemma max_eq_half_add_add_abs_sub {x y : R} : max x y = 2⁻¹ * (x + y + |x - y|) :=
by cases le_total x y with h h; field_simp [h, abs_of_nonneg, abs_of_nonpos, mul_two]; abel

end

namespace continuous_map

section lattice
variables {α : Type*} [topological_space α]
variables {β : Type*} [linear_ordered_field β] [topological_space β]
  [order_topology β] [topological_ring β]

lemma inf_eq (f g : C(α, β)) : f ⊓ g = (2⁻¹ : β) • (f + g - |f - g|) :=
ext (λ x, by simpa using min_eq_half_add_sub_abs_sub)

-- Not sure why this is grosser than `inf_eq`:
lemma sup_eq (f g : C(α, β)) : f ⊔ g = (2⁻¹ : β) • (f + g + |f - g|) :=
ext (λ x, by simpa [mul_add] using @max_eq_half_add_add_abs_sub _ _ (f x) (g x))

end lattice

end continuous_map


import SciLean
import SciLean.Functions.OdeSolve
import SciLean.Solver.Solver
-- import SciLean.Mechanics
-- import SciLean.Operators.ODE
-- import SciLean.Solver.Solver
-- -- import SciLean.Tactic.LiftLimit
-- -- import SciLean.Tactic.FinishImpl
-- import SciLean.Data.DataArray
-- import SciLean.Core.Extra

set_option synthInstance.maxSize 2048
-- set_option synthInstance.maxHeartbeats 500000
-- set_option maxHeartbeats 500000

open Function SciLean

variable {n : Nat} [Nonempty (Fin n)]

-- set_option trace.Meta.synthInstance true in
def H (m k : ℝ) (x p : ℝ^{n}) : ℝ :=
  let Δx := (1 : ℝ)/(n : ℝ)
  (Δx/(2*m)) * ‖p‖² + (Δx * k/2) * (∑ i , ‖x[i] - x[i - ⟨1,sorry⟩]‖²)

theorem sum_add {ι X} [Enumtype ι] [Vec X] (f g : ι → X)
  : ∑ i, (f i + g i) = ∑ i, f i + ∑ i, g i := sorry_proof

@[simp]
theorem sum_setElem_zero {ι X Xι} [Enumtype ι] [Vec X] [ArrayType Xι ι X] (f : ι → X) (h : ι → ι) [HasInv h]
  : ∑ i, setElem (0 : Xι) (h i) (f i) = introElem λ i => f (h⁻¹ i) := sorry_proof

function_properties H (m k : ℝ) (x p : ℝ^{n}) : ℝ
argument x
  def ∂† by
    unfold H
    symdiff
    simp [sum_add]
argument p
  def ∂† by
    unfold H
    symdiff

approx solver (m k : ℝ) (steps : Nat)
  :=  odeSolve (λ t (x,p) => ( ∇ (p':=p), H (n:=n) m k x  p',
                              -∇ (x':=x), H (n:=n) m k x' p))

by
  -- Unfold Hamiltonian definition and compute gradients
  symdiff; symdiff

  -- Apply RK4 method
  rw [odeSolve_fixed_dt runge_kutta4_step]
  approx_limit steps; simp; intro steps'

def main : IO Unit := do

  let substeps := 1
  let m := 1.0
  let k := 100000.0

  let N : Nat := 100
  have h : Nonempty (Fin N) := sorry

  let Δt := 0.1
  let x₀ : (ℝ^{N}) := ⊞ (i : Fin N), (Real.sin ((i.1 : ℝ)/10))
  let p₀ : (ℝ^{N}) := ⊞ i, (0 : ℝ)
  let mut t := 0
  let mut (x,p) := (x₀, p₀)

  for i in [0:1000] do

    (x, p) := solver m k substeps t (x, p) Δt
    t += Δt

    let M : Nat := 20
    for (m : Nat) in [0:M] do
      for (n : Nat) in [0:N] do

        let xi := x[!n]
        if (2*m - M)/(M : ℝ) - xi < 0  then
          IO.print "x"
        else
          IO.print "."

      IO.println ""

-- #eval main


import number_theory.padics.padic_integers

--OUTPUT 1
theorem p_adic_units (p x : ℕ) : prime p → coprime x p → is_unit (x : ℤ_[p]) :=
begin
  assume hprime hcoprime,
  rw [coprime,nat.prime.coprime],
  rw [not_lt],
  rw [norm_eq_zero_iff],
  rw [← int.coe_nat_ne_zero_iff],
  exact hcoprime,
end

--OUTPUT 2
theorem p_adic_units (p : ℕ) [prime p] (x : ℕ) (hx : nat.coprime x p) :
    (∃ (y : ℚ), x * y = 1) :=
begin
    -- We prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
    have h1 : (∀ (y : ℚ), x * y ≠ 1) → ¬ (nat.coprime x p),
    {
        assume h2 h3,
        have h4 : p ∣ x, from nat.dvd_of_not_coprime h2 h3,
        have h5 : nat.nat_abs x < p, from nat.lt_of_dvd_of_lt h4 (nat.prime.pos p),
        have h6 : (∃ (y : ℚ), x * y = 1), from p_adic_norm_1 (nat.nat_abs x) h5,
        show false, from h2 h6.right,
    },
    have h7 : (∃ (y : ℚ), x * y = 1), from p_adic_norm_1 x hx,
    exact h1 h7.right hx,
end

--OUTPUT 3
theorem zp_units {p x : ℕ} (hp : prime p) (hx : x ≠ 0) : (gcd x p = ₁) ↔ (x ∈ units (ℤ p)) :=
begin
  have h1 : (gcd x p = ₁) ↔ (x ∣ p ∧ p ∣ x), from by {
    split,
      assume hgcd : gcd x p = ₁,
      have h2 : gcd x p = x ∧ gcd x p = p, from by {
        split,
          exact hgcd.symm ▸ gcd_eq_left x p,
          exact hgcd.symm ▸ gcd_eq_right x p,
      },
      have h3 : x ∣ p ∧ p ∣ x, from by {
        split,
          exact h2.left ▸ dvd_gcd,
          exact h2.right ▸ dvd_gcd,
      },
      exact h3,
      assume hgcd : x ∣ p ∧ p ∣ x,
      have h2 : gcd x p = x ∧ gcd x p = p, from by {
        split,
          exact (dvd_gcd x p).mp hgcd.left,
          exact (dvd_gcd x p).mp hgcd.right,
      },
      have h3 : gcd x p = ₁, from by {
        rw [←gcd_eq_left x p, ←gcd_eq_right x p] at h2,
        exact h2.left.symm ▸ h2.right.symm ▸ gcd_one x p,
      },
      exact h3,
  },
  have h2 : x ∣ p ↔ x ∈ (ℤ p).units, from by {
    split,
      assume hdvd : x ∣ p,
      have h3 : (x : ℤ p) ≠ 0, from by {
        have h4 : (x : ℤ p) ≠ 0, from by {
          assume h5 : (x : ℤ p) = 0,
          have h6 : x = 0, from by {
            have h7 : (x : ℤ p) = 0, from by {
              rw [←int.coe_nat_zero, h5],
            },
            exact int.cast_inj.mp h7,
          },
          exact hx h6,
        },
        exact h4,
      },
      have h4 : (x : ℤ p) ∣ p, from by {
        have h5 : (x : ℤ p) ∣ (p : ℤ p), from by {
          rw int.coe_nat_dvd,
          exact hdvd,
        },
        exact h5,
      },
      have h5 : (x : ℤ p) ∣ 1, from by {
        have h6 : (p : ℤ p) ∣ (p : ℤ p), from by {
          rw int.coe_nat_dvd,
          exact dvd_refl p,
        },
        have h7 : (x : ℤ p) ∣ (p : ℤ p), from by {
          rw int.coe_nat_dvd,
          exact hdvd,
        },
        have h8 : (x : ℤ p) ∣ 1, from by {
          have h9 : (p : ℤ p) ∣ 1, from by {
            exact int.cast_dvd.mp (prime.dvd_one hp),
          },
          exact int.dvd_of_dvd_mul_left h7 h9,
        },
        exact h8,
      },
      have h6 : (x : ℤ p) ∈ (ℤ p).units, from by {
        have h7 : (x : ℤ p) ≠ 0, from by {
          have h8 : (x : ℤ p) ≠ 0, from by {
            assume h9 : (x : ℤ p) = 0,
            have h10 : x = 0, from by {
              have h11 : (x : ℤ p) = 0, from by {
                rw [←int.coe_nat_zero, h9],
              },
              exact int.cast_inj.mp h11,
            },
            exact hx h10,
          },
          exact h8,
        },
        have h8 : (x : ℤ p) ∣ 1, from by {
          have h9 : (x : ℤ p) ∣ 1, from by {
            have h10 : (p : ℤ p) ∣ 1, from by {
              exact int.cast_dvd.mp (prime.dvd_one hp),
            },
            have h11 : (x : ℤ p) ∣ (p : ℤ p), from by {
              rw int.coe_nat_dvd,
              exact hdvd,
            },
            exact int.dvd_of_dvd_mul_left h11 h10,
          },
          exact h9,
        },
        exact ⟨h7,h8⟩,
      },
      exact h6,
      assume hunit : (x : ℤ p) ∈ (ℤ p).units,
      have h3 : (x : ℤ p) ∣ 1, from by {
        have h4 : (x : ℤ p) ∣ 1, from by {
          exact hunit.right,
        },
        exact h4,
      },
      have h4 : (p : ℤ p) ∣ 1, from by {
        have h5 : (p : ℤ p) ∣ 1, from by {
          exact int.cast_dvd.mp (prime.dvd_one hp),
        },
        exact h5,
      },
      have h5 : (p : ℤ p) ∣ (p : ℤ p), from by {
        have h6 : (p : ℤ p) ∣ (p : ℤ p), from by {
          rw int.coe_nat_dvd,
          exact dvd_refl p,
        },
        exact h6,
      },
      have h6 : (x : ℤ p) ∣ (p : ℤ p), from by {
        exact int.dvd_of_dvd_mul_left h3 h5,
      },
      have h7 : x ∣ p, from by {
        rw int.coe_nat_dvd,
        exact int.dvd_coe.mp h6,
      },
      exact h7,
  },
  have h3 : (x ∣ p ∧ p ∣ x) ↔ (x ∈ (ℤ p).units ∧ p ∈ (ℤ p).units), from by {
    split,
      assume hgcd : x ∣ p ∧ p ∣ x,
      have h4 : x ∈ (ℤ p).units, from by {
        have h5 : x ∈ (ℤ p).units, from by {
          rw int.coe_nat_dvd,
          exact hgcd.left,
        },
        exact h5,
      },
      have h5 : p ∈ (ℤ p).units, from by {
        have h6 : p ∈ (ℤ p).units, from by {
          rw int.coe_nat_dvd,
          exact hgcd.right,
        },
        exact h6,
      },
      have h6 : (x ∈ (ℤ p).units ∧ p ∈ (ℤ p).units), from by {
        split,
          exact h4,
          exact h5,
      },
      exact h6,
      assume hgcd : x ∈ (ℤ p).units ∧ p ∈ (ℤ p).units,
      have h4 : x ∣ p, from by {
        have h5 : x ∣ p, from by {
          rw int.coe_nat_dvd,
          exact hgcd.left.right,
        },
        exact
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem p_adic_units (p : ℕ) (x : ℕ) (h : gcd x p = 1) : is_unit (zmod p x) :=
begin
  -- Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
  have h1 : ¬ is_unit (zmod p x) → gcd x p ≠ 1, from by {
    assume : ¬ is_unit (zmod p x),
    have h2 : norm (zmod p x) ≠ 1, from by {
      assume : norm (zmod p x) = 1,
      have : is_unit (zmod p x), from unit_iff_norm_one.mp (by {rw [← this,norm_eq_nat_abs],ring}),
      contradiction,
    },
    have h3 : norm (zmod p x) < 1, from by apply nat.lt_of_le_of_ne (norm_le_one_iff.mp $ norm_eq_nat_abs.mp $ by {rw [← norm_eq_nat_abs],ring}) h2,
    have h4 : p ∣ x, from by apply (p_dvd_of_norm_lt_one h3),
    have h5 : gcd x p ≠ 1, from by apply (not_coprime_of_dvd_prime h4),
    exact h5,
  },
  have h2 : is_unit (zmod p x) → gcd x p = 1, from by {
    assume : is_unit (zmod p x),
    have h3 : norm (zmod p x) = 1, from by {
      have h4 : norm (zmod p x) ≤ 1, from by apply norm_le_one_iff.mp $ norm_eq_nat_abs.mp $ by {rw [← norm_eq_nat_abs],ring},
      have h5 : ¬ norm (zmod p x) < 1, from by {
        assume : norm (zmod p x) < 1,
        have h6 : p ∣ x, from by apply (p_dvd_of_norm_lt_one this),
        have h7 : gcd x p ≠ 1, from by apply (not_coprime_of_dvd_prime h6),
        contradiction,
      },
      apply le_antisymm h4 h5,
    },
    have h4 : norm (zmod p x) = 1, from by {rw [← this],ring},
    have h5 : is_unit (zmod p x), from by {apply unit_iff_norm_one.mp h4,},
    have h6 : ∃ z : zmod p x, (zmod p x) * z = 1, from by {apply is_unit_iff_dvd_one.mp h5,},
    have h7 : ∃ z : zmod p x, (z * (zmod p x)) = 1, from by {
      have h8 : ∃ z : zmod p x, (zmod p x) * z = 1, from by {exact h6},
      have h9 : ∃ z : zmod p x, (z * (zmod p x)) = 1, from by {apply exists.elim h8,assume (x : zmod p x) (h10 : (zmod p x) * x = 1),use x⁻¹,rw [mul_inv_eq_one_of_mul_eq_one h10,inv_one],},
      exact h9,
    },
    have h8 : ∃ z : ℕ, (z * x) ≡ 1 [MOD p], from by {
      have h9 : ∃ z : zmod p x, (z * (zmod p x)) = 1, from by {exact h7},
      have h10 : ∃ z : ℕ, (z * x) ≡ 1 [MOD p], from by {apply exists.elim h9,assume (x : zmod p x) (h11 : (x * (zmod p x)) = 1),use x.val,rw [mul_eq_one_iff_dvd_one h11,← eq_one_iff_dvd,← eq_one_iff_dvd,← eq_one_iff_dvd],},
      exact h10,
    },
    have h9 : gcd x p = 1, from by {apply exists.elim h8,assume (x : ℕ) (h10 : (x * x) ≡ 1 [MOD p]),rw [← eq_one_iff_dvd,← eq_one_iff_dvd,← eq_one_iff_dvd],},
    exact h9,
  },
  have h3 : is_unit (zmod p x) → gcd x p = 1, from by {exact h2},
  have h4 : ¬ is_unit (zmod p x) → gcd x p ≠ 1, from by {exact h1},
  exact h3,
end

--OUTPUT 5
theorem p_adic_units (p : ℕ) (x : ℕ) (h : x.coprime p) : x.val_min p = 1 :=
begin
    -- We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$.
    have h_not_unit : x.val_min p ≠ 1, from mt (λ h_eq, h_eq.symm ▸ h.symm),
    -- Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
    have h_lt : x.val_min p < 1, from lt_of_le_of_ne (val_min_le x p) h_not_unit,
    -- But this must imply that $p | x$.
    have h_dvd : p ∣ x, from nat.dvd_of_mod_lt_of_pos (x.mod p) h_lt (nat.pos_of_ne_zero (ne_of_gt (show 0 < p, from dec_trivial))),
    -- This completes our proof.
    exact (not_coprime_of_dvd_of_coprime h_dvd h),
end

--OUTPUT 6
theorem p_adic_units (p : ℕ) (x : ℕ) (hx : coprime p x) : ∃ y, x * y = 1 :=
begin
  -- prove contrapositive, that is, not (x is a unit of $\mathbb{Z}_p$) → not (x is coprime to $p$)
  have h1 : ¬ x ∈ units (ℤ p), from by {
    assume h2 : x ∈ units (ℤ p),
    have h3 : x.norm = 1, from by {apply norm_eq_one_iff_units,exact h2},
    have h4 : p ∣ x, from by {apply not_lt_iff_le,rw ← h3,exact nat.not_lt_zero _},
    show false, from by {exact hx.2 h4},
  },
  have h2 : x.norm = 1 ∨ x.norm < 1, from by {apply nat.eq_or_lt_of_le,exact norm_nonneg x},
  have h3 : x.norm < 1, from by {cases h2,exact h1 h2,exact h2},
  have h4 : p ∣ x, from by {apply not_lt_iff_le,rw ← h3,exact nat.not_lt_zero _},
  show false, from by {exact hx.2 h4},
end

--OUTPUT 7
theorem p_adic_units {p : ℕ} (hp : prime p) (x : ℕ) (hx : nat.coprime x p) : is_unit (x : ℕ[p]) :=
begin
  have h1 : ¬ is_unit (x : ℕ[p]) → nat.dvd p x, from assume h2 : ¬ is_unit (x : ℕ[p]),
  begin
    have h3 : ¬ int.norm_nat (x : ℕ[p]) = 1, from assume h4 : ¬ int.norm_nat (x : ℕ[p]) = 1,
      by {exact h2 (int.mk_units_of_norm h4)},
    have h5 : ¬ int.norm_nat (x : ℕ[p]) < 1, from assume h6 : ¬ int.norm_nat (x : ℕ[p]) < 1,
      lt_irrefl 1 (lt_of_not_ge h6),
    have h7 : int.norm_nat (x : ℕ[p]) = 0, from eq_zero_of_le_zero (le_of_not_gt h5),
    have h8 : x = 0, from norm_nat_eq_zero (int.mk_nat_of_norm h7),
    have h9 : p ∣ 0, from dvd_of_dvd_mul (dvd_zero (x : ℕ[p])) hp.pos,
    have h10 : p ∣ x, from dvd_of_dvd_of_eq (dvd_zero x) h8 h9,
    exact h10,
  end,
  have h2 : ¬ nat.dvd p x → is_unit (x : ℕ[p]), from assume h3 : ¬ nat.dvd p x,
  begin
    have h4 : int.norm_nat (x : ℕ[p]) = 1, from norm_one_of_coprime (int.mk_nat_of_norm (norm_nat_le_one (x : ℕ[p]))) h3,
    exact int.mk_units_of_norm h4,
  end,
  exact iff.mp (not_iff_not_of_iff (iff.symm (iff.trans h1 h2))) hx,
end

--OUTPUT 8
theorem p_adic_units (p : ℕ) (x : ℕ) : coprime p x → is_unit (↑x : ℤ_[p]) :=
begin
  apply not_imp_not,
  assume h1 : ¬ is_unit (↑x : ℤ_[p]),
  assume h2 : coprime p x,
  have h3 : p ∣ x, from by {
    have h4 : ∃ (n : ℕ), (↑x : ℤ_[p]) = n : ℤ_[p], from exists_nat_cast x,
    have h5 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
    have h6 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
    have h7 : ∃ (n : ℕ), (↑x : ℤ_[p]) = n : ℤ_[p], from exists_nat_cast x,
    have h8 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
    have h9 : p ∣ (↑x : ℤ), from by {
      have h10 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h11 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h12 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h13 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h14 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h15 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h16 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h17 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h18 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h19 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h20 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h21 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h22 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h23 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h24 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h25 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h26 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h27 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h28 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h29 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h30 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h31 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h32 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h33 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h34 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h35 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h36 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h37 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h38 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h39 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h40 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h41 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h42 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h43 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h44 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h45 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h46 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h47 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h48 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h49 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h50 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h51 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h52 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h53 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {rw nat_cast_eq_iff h7.left,apply nat.eq_one_of_dvd_one h7.right,},
      have h54 : (↑x : ℤ) ≠ 1, from by {contradiction},
      have h55 : (↑x : ℤ_[p]) ≠ 0, from by {contradiction},
      have h56 : (↑x : ℤ_[p]) ≠ 1, from by {contradiction},
      have h57 : (↑x : ℤ_[p]) = (↑x : ℤ), from by {
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
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
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
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
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
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  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) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
p-adic units
Given a prime number $p$ and a natural number $x$, if $x$ is coprime to $p$, then $x$ is a unit in the $p$-adic integers.
`proof`
Let us prove the contrapositive, that is, is $x$ is not a unit of $\mathbb{Z}_p$, then $x$ is not coprime to $p$.
We know that any element of $\mathbb{Z}_p$ is a unit if and only if it has norm 1, thus $\Vert x \Vert \neq 1$. Also, since every element of $\mathbb{Z}_p$ must have norm less than or equal to 1, we conclude that $\Vert x \Vert < 1$.
But this must imply that $p | x$.
This completes our proof.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import ModelChecking.Mathlib.Multiset

structure Finset (α) where
  val : Multiset α
  nodup : Multiset.nodup val

def Multiset.toFinset [DecidableEq α] (s : Multiset α) : Finset α := ⟨_, nodupEraseDup s⟩

namespace Finset

instance : Mem α (Finset α) := ⟨λ a f => a ∈ f.val⟩

instance : Union (Finset α) := sorry

instance : Inter (Finset α) := sorry

instance : EmptyCollection (Finset α) := ⟨{ val := ∅, nodup := Multiset.nodupEmpty }⟩

instance : Inhabited (Finset α) where
  default := ∅

protected def bUnion [DecidableEq β] (s : Finset α) (t : α → Finset β) : Finset β :=
  (s.val.bind (λ a => (t a).val)).toFinset

def image (f : α → β) (s : Finset α) : Finset β := sorry

def singleton (a : α) : Finset α := ⟨[a], sorry⟩

theorem mem_singleton_self (a : α) : a ∈ (Finset.singleton a) := sorry

theorem not_mem_singleton {a b : α} : ¬(a ∈ Finset.singleton b) ↔ a ≠ b := sorry

instance : Coe (Finset α) (Set α) := ⟨λ f => {x | x ∈ f}⟩

def filter (s : Finset α) (p : α → Prop) [DecidablePred p] : Finset α := sorry

theorem ext_iff {s₁ s₂ : Finset α} : s₁ = s₂ ↔ ∀ a, a ∈ s₁ ↔ a ∈ s₂ := sorry

theorem ext {s₁ s₂ : Finset α} : (∀ a, a ∈ s₁ ↔ a ∈ s₂) → s₁ = s₂ := ext_iff.mpr

def range (n : ℕ) : Finset ℕ := sorry

@[simp] theorem mem_range : m ∈ range n ↔ m < n := sorry

@[simp] theorem mem_coe {a : α} {s : Finset α} : a ∈ (s : Set α) ↔ a ∈ s := sorry

@[simp] theorem coe_filter (p : α → Prop) [DecidablePred p] (s : Finset α) : ↑(s.filter p) = ({x ∈ (↑s : Set α) | p x} : Set α) := sorry

@[simp] theorem mem_filter (p : α → Prop) [DecidablePred p] {s : Finset α} {a : α} : a ∈ s.filter p ↔ a ∈ s ∧ p a := sorry

instance : Subset (Finset α) := sorry

theorem subset_iff {s₁ s₂ : Finset α} : s₁ ⊆ s₂ ↔ ∀ {x}, x ∈ s₁ → x ∈ s₂ := sorry

@[simp] theorem subset.refl (s : Finset α) : s ⊆ s := sorry

theorem mem_of_subset {s₁ s₂ : Finset α} {a : α} : s₁ ⊆ s₂ → a ∈ s₁ → a ∈ s₂ := sorry

theorem inter_subset_right (s₁ s₂ : Finset α) [DecidableEq α] : s₁ ∩ s₂ ⊆ s₂ := sorry

@[simp] theorem mem_image {s : Finset α} {f : α → β} {b : β} : b ∈ s.image f ↔ ∃ a ∈ s, f a = b := sorry

@[simp] theorem mem_union {a : α} {s₁ s₂ : Finset α} : a ∈ s₁ ∪ s₂ ↔ a ∈ s₁ ∨ a ∈ s₂ := sorry

instance : Sdiff (Finset α) := sorry

end Finset

def List.toFinset (l : List α) : Finset α := sorry


import tactic

noncomputable theory
open_locale classical

-- # Propositions as Types
--------------------------

/-  How should we interpret (a : A)

a is a term
A is a Type (a collection of terms)
analogous to a ∈ A (in set theory)

If A is a Proposition
then a : A means that we have a proof of A

h : p1 ≠ p2

p1 ≠ p2 is a Proposition but it is itself a Type
h is a term (and also a proof) of Type p1 ≠ p2

Curry-Howard Isomorphism : CS ∩ Math
-------------------------------------
Propositions ↔ Types
Proofs ↔ Terms
Algorithms ↔ Proofs ↔ Programs
Definitions (of CS functions) ↔ Theorem statements

Curry -> Function currying && Haskell
Howard : Prof. at University of Illinois -- Chicago

def f  : A × B → C    (uncurry-ied function)
def f' : A → B → C   (curry-ied function)

***Lambda Calculus***  This is the underlying math behind any higher-order programming language

f (a, b) : C
f a    ----- Type error

f' : A → B → C
f' a : B → C
f' a b : C

Proof-irrelevance:  (works only for Prop type)
---------------------------------------------
It doesn't matter which proof we pick
h : p1 ≠ p2
We cannot break h into smaller parts.
In other words, if h' : p1 ≠ p2
Then h and h' are the same.

h h' : p1 ≠ p2 (here they are irrelevant)
5 8  : ℕ
5 ≠ 8 (here the terms are not! irrelevant)

-/

/-
# Admin stuff :
---------------
- We can meet MTW both orning and afternoon sessions.
- That gives us 5 workdays.

- Friday : Show project to Zulip community. (https://leanprover.zulipchat.com/)
  -- Definitely always have zero errors.
  -- Make the github public
  -- Share our code and ask for feedback.
  -- Ask if we can submit some of our code to Mathlib as PRs. (Code rot)

- How many propositions can we get done by the end of this week?
  -- Euclid  :
  -- Hilbert :

- Final presentation video/submission.
  -- Presentation and Poster are due June 24th.
  -- June 23rd: it needs to be ready.
  -- June 22nd: I can review it.
  -- June 21st: Submit a draftversion to me for review.
  -- June 18,19,20 : Work on presentation and poster. (90% of the content can be picked up from the wiki).
  -- Presentation should  convey:
  1. Goal: learn Lean & formalize geometry.
  2. Why is it important?
  3. What does working with lean look/feel like.
  4. The math involved -- type theory, Euclid, Hilbert. (maybe mention Tarski).
  5. How far did we get, what more needs to be formalized.

# Lambdas :
-----------
μ : to denote distance (it is a "measure")
There is an entire theory about "measures" called Measure Theory (leangths, areas, integral calculus, propobility theory etc.)

λ : is a reserved symbol. Used for lambda expressions (Lambda Calculus?).

mlist : is a python list
  >>> sorted(mylist, key=lambda value : str(value))

Theory of Computers/Computation
- Alan Turing (Turing machines)   : underlying theory for languages like C, C++, Sql
- Alonzo Church (Lambda Calculus) : more higher-level. All functional languages are based on this -- Haskell, Scala, Lea, Agda, Coq etc.
- Church-Turing Thesis
  => Turing machines == Lambda calculus == Every computer every possible == Human brains

Lambda calculus depends on the concept of functions as first-class objects.
Lambda operator is used for defining functions easily.

def f (n : ℕ) := n + 1

f = λ (n : ℕ) (s : string) , n + 1 + len(s)

Think of λ as a function-factory.

# Mathematical Trust :
---------------------

Things that were proved by computer but not by hand:
- Four Color Theorem: Haken and Appel's proof.
  They used a computer.

Things that were proved by  hand but not by computer:
- ABC conjecture -- Mochizuki proposed a proof.

Things that were verified both ways:
- Fermat's last theorem : Andrew Wiles' proof

Traditionally, we don't trust the author of the proof but we do trust
a review committee (consisting of other mathematicians).

Now, we can formalize math into a Theorem Prover.  But then, the
problem shifts to trusting the Language itself.  The solution is to
minimize the size of the "Language kernel" ~ 1000 lines of codes.

MetaMath project is a meta project for verifying the verifier.
MetaMath's kernel is even smaller ~ 100 lines of code.

This idea is so popular that it is gaining traction in the form of
Software and Hardware verification.

Paper → Journal → Peer review → Published
Paper + Coputer-checked Proof → Journal → Publish
Software + Software verification certificate → Ubuntu/Windows/Apple store

-/


/- This module defines lemmas to simplify equalities between literals. -/
import data.bitvec
import ..vector

namespace bitvec

open vector

local infix `++`:65 := vector.append

section adc_lemmas

@[simp]
theorem adc_match_def {n : ℕ} (r : bool × bitvec n) : adc._match_1 r = r^.fst :: r^.snd :=
begin
  cases r,
  simp [adc._match_1]
end

@[simp]
theorem adc_empty (x y : bitvec 0) (c : bool)
: adc x y c = cons c nil :=
begin
  simp [adc, map_accumr₂_nil, adc_match_def],
end

theorem adc_append1 {n : ℕ} (x : bitvec n) (a : bool) (y : bitvec n) (b : bool) (c : bool)
: adc (x ++ cons a nil) (y ++ cons b nil) c
  = adc x y (bitvec.carry a b c) ++ cons (bitvec.xor3 a b c) nil :=
begin
  apply vector.eq,
  simp [adc, map_accumr₂_append1, adc_match_def]
end

@[simp]
theorem carry_eq (a b : bool) : bitvec.carry a a b = a :=
begin
  unfold bitvec.carry,
  cases a, all_goals { simp }
end

@[simp]
theorem xor3_eq (a b : bool) : bitvec.xor3 a a b = b :=
begin
  unfold bitvec.xor3,
  cases a, all_goals { simp }
end

theorem adc_zero {n : ℕ} (x : bitvec n) : adc x (repeat ff n) ff = (ff :: x) :=
begin
  induction n with n ind,
  { apply vector.eq,
    simp [adc_empty],
  },
  { apply (eq.subst (init_append_last_self x)),
    apply vector.eq,
    simp [repeat_succ_to_append, adc_append1, bitvec.carry, bitvec.xor3, ind (init x)]
  }
end

theorem adc_eq {n : ℕ} (x : bitvec n) (b : bool) : adc x x b = x ++ cons b nil :=
begin
  revert b,
  induction n with n ind,
  { intro b,
    apply vector.eq,
    simp [adc_empty],
  },
  { intro b,
    apply (eq.subst (init_append_last_self x)),
    simp [adc_append1, ind (init x)],
  }
end

end adc_lemmas

section literal_definition_lemmas

open nat

-- Definition of 0
theorem zero_to_repeat (n : ℕ) : (0 : bitvec n) = repeat ff n :=
begin
  refl
end

theorem one_to_repeat (n : ℕ)
: (1 : bitvec (succ n)) = repeat ff n ++ cons tt nil :=
begin
  trivial,
end

theorem bit0_to_repeat {n : ℕ} (x : bitvec (succ n))
: bit0 x = vector.total_tail x ++ cons ff nil :=
begin
  unfold bit0,
  unfold has_add.add bitvec.add,
  apply vector.eq,
  simp [adc_eq, list.tail_append],
end

theorem bit1_to_repeat {n : ℕ} (x : bitvec (succ n))
: bit1 x = vector.total_tail x ++ cons tt nil :=
begin
  unfold bit1,
  unfold has_add.add bitvec.add,
  apply vector.eq,
  simp [one_to_repeat, bit0_to_repeat, adc_append1, bitvec.carry, bitvec.xor3],
  dsimp [nat.succ_sub_one],
  simp [@adc_zero n (total_tail x)]
end

end literal_definition_lemmas

-- Lemmas about total tail of the natural number literal primitives
section total_tail_literal_lemmas

@[simp]
theorem total_tail_zero (n : ℕ)
: vector.total_tail (0 : bitvec n) = 0 :=
begin
  apply vector.eq,
  simp [zero_to_repeat, vector.to_list_total_tail, list.tail_repeat],
end

@[simp]
theorem total_tail_one (n : ℕ)
: vector.total_tail (1 : bitvec n) = 1 :=
begin
  -- Case for n = 0
  cases n with n, simp,
  -- Case for n = 1
  cases n with n, simp,
  -- Case for n ≥ 2
  { apply vector.eq,
    unfold has_one.one,
    trivial,
  }
end

@[simp]
theorem total_tail_bit0 {n : ℕ} (x : bitvec n)
: vector.total_tail (bit0 x) = bit0 (vector.total_tail x) :=
begin
  -- Case for n = 0
  cases n with n, { simp },
  -- Case for n = 1
  cases n with n, { simp },
  -- Case for n ≥ 2
  { apply vector.eq,
    simp [bit0_to_repeat, list.tail_append, vector.length_to_list]
  }
end

@[simp]
theorem total_tail_bit1 {n : ℕ} (x : bitvec n)
: vector.total_tail (bit1 x : bitvec n) = bit1 (vector.total_tail x) :=
begin
  -- Case for n = 0
  cases n with n, { simp },
  -- Case for n = 1
  cases n with n, { simp },
  -- Case for n ≥ 2
  { apply vector.eq,
    simp [bit1_to_repeat, list.tail_append, vector.length_to_list],
  }
end

end total_tail_literal_lemmas

-- Simplification lemmas for bitvector literals
section literal_simplification_literals

-- This tactic simplifies the bitvector equalitiy lemmas
private
meta def simp_bvlit_rule : tactic unit := do
    let lemmas : list expr :=
      [ -- Core lemmas
        expr.const `and_true []
      , expr.const `true_and []
      , expr.const `and_false []
      , expr.const `false_and []
      , expr.const `eq_self_iff_true [level.of_nat 1]
      , expr.const `tt_eq_ff_eq_false []
      , expr.const `ff_eq_tt_eq_false []
        -- Natural number lemmas
      , expr.const `nat.not_succ_eq_zero []
      , expr.const `nat.not_zero_eq_succ []
      , expr.const `nat.succ_sub_succ []
        -- Vector lemmas
      , expr.const `vector.repeat_succ_to_append []
      , expr.const `vector.zero_vec_always_eq [level.of_nat 0]
      , expr.const `vector.cons_eq_cons [level.of_nat 0]
      , expr.const `vector.append_eq_append [level.of_nat 0]
      , expr.const `bitvec.zero_to_repeat []
      , expr.const `bitvec.one_to_repeat []
      , expr.const `bitvec.bit0_to_repeat []
      , expr.const `bitvec.bit1_to_repeat []
      ] in do
    s ← simp_lemmas.mk.append lemmas,
    tactic.simp_target s,
    tactic.try (tactic.reflexivity)

@[simp]
theorem zero_eq_one  (n : ℕ) : (0 : bitvec n) = 1 ↔ n = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem zero_eq_bit0 {n : ℕ} (y : bitvec n) : (0 : bitvec n) = bit0 y ↔ 0 = vector.total_tail y :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem zero_eq_bit1 {n : ℕ} (y : bitvec n) : (0 : bitvec n) = bit1 y ↔ n = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem one_eq_zero (n : ℕ)                 : (1 : bitvec n) = 0      ↔ n = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem one_eq_bit0 {n : ℕ} (y : bitvec n)  : (1 : bitvec n) = bit0 y ↔ n = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem one_eq_bit1 {n : ℕ} (y : bitvec n)  : (1 : bitvec n) = bit1 y ↔ 0 = vector.total_tail y :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem bit0_eq_zero {n : ℕ} (x   : bitvec n) : bit0 x = 0      ↔ vector.total_tail x = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem bit0_eq_one  {n : ℕ} (x   : bitvec n) : bit0 x = 1      ↔ n = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem bit0_eq_bit0 {n : ℕ} (x y : bitvec n) : bit0 x = bit0 y ↔ vector.total_tail x = vector.total_tail y :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem bit0_eq_bit1 {n : ℕ} (x y : bitvec n) : bit0 x = bit1 y ↔ n = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem bit1_eq_zero {n : ℕ} (x : bitvec n)   : bit1 x = 0      ↔ n = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem bit1_eq_one  {n : ℕ} (x : bitvec n)   : bit1 x = 1      ↔ vector.total_tail x = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem bit1_eq_bit0 {n : ℕ} (x y : bitvec n) : bit1 x = bit0 y ↔ n = 0 :=
begin cases n, all_goals { simp_bvlit_rule } end

@[simp]
theorem bit1_eq_bit1 {n : ℕ} (x y : bitvec n) : bit1 x = bit1 y ↔ vector.total_tail x = vector.total_tail y :=
begin cases n, all_goals { simp_bvlit_rule } end

end literal_simplification_literals

end bitvec