import o_minimal.coordinates
import o_minimal.structure

-- Stripped-down version of `o_minimal.definable`
-- without implicit definability hypotheses on the types.

universe u

namespace o_minimal

open_locale finvec

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

variables {X : Type*} [has_coordinates R X]
variables {Y : Type*} [has_coordinates R Y]

def struc.def_coords (s : set X) : Prop :=
S.definable (coords R '' s)

namespace struc.def_coords

variables {S}

lemma diag (dX : S.def_coords (set.univ : set X)) :
  S.def_coords {p : X × X | p.1 = p.2} :=
begin
  unfold struc.def_coords,
  convert S.definable_inter (S.definable_prod_rn dX) S.definable_diag_rn,
  refine set.ext (finvec.rec (λ v w, _)),
  have :
    (∃ (x : X), coords R x = v ∧ coords R x = w) ↔
    v ∈ coordinate_image R X ∧ v = w,
  { split,
    { rintros ⟨x, rfl, rfl⟩, exact ⟨⟨x, rfl⟩, rfl⟩ },
    { rintros ⟨⟨x, rfl⟩, rfl⟩, exact ⟨x, rfl, rfl⟩ } },
  simp,
  dsimp,
  simpa [finvec.append.inj_iff]
end

lemma reindex (dX : S.def_coords (set.univ : set X)) {f : X → Y} (hf : is_reindexing R f)
  {s : set Y} (ds : S.def_coords s) : S.def_coords (f ⁻¹' s) :=
begin
  cases hf with fσ hf,
  unfold struc.def_coords,
  -- The preimage f ⁻¹' s, as a subset of the Rⁿ in which X lives,
  -- is the intersection of X with the preimage of s under the reindexing.
  convert S.definable_inter dX (S.definable_reindex fσ ds),
  ext z,
  suffices : (∃ (x : X), f x ∈ s ∧ coords R x = z) ↔
    z ∈ set.range (@coords R X _) ∧ ∃ (y : Y), y ∈ s ∧ coords R y = z ∘ fσ,
  { simpa },
  -- TODO: funext'd version of `is_reindexing.hf`
  replace hf : ∀ (x : X), coords R x ∘ fσ = coords R (f x) := λ x, funext (λ i, (hf x i)),
  split,
  { rintro ⟨x, hfx, rfl⟩,
    refine ⟨set.mem_range_self _, f x, hfx, (hf x).symm⟩ },
  { rintro ⟨⟨x, rfl⟩, y, hy, H⟩,
    rw hf x at H,
    replace hf := injective_coords _ H,
    subst y,
    exact ⟨x, hy, rfl⟩ }
end

lemma «exists» {s : X → Y → Prop} (ds : S.def_coords {p : X × Y | s p.1 p.2}) :
  S.def_coords {x | ∃ y, s x y} :=
begin
  unfold struc.def_coords at ⊢ ds,
  convert S.definable_proj ds using 1,
  ext x,
  rw [set.image_image],
  simp
end

lemma inter {s t : set X} (ds : S.def_coords s) (dt : S.def_coords t) :
  S.def_coords (s ∩ t) :=
begin
  unfold struc.def_coords,
  convert S.definable_inter ds dt,
  simp [set.image_inter (injective_coords X)]
end

lemma prod_univ (dX : S.def_coords (set.univ : set X)) (dY : S.def_coords (set.univ : set Y)) :
  S.def_coords (set.univ : set (X × Y)) :=
begin
  unfold struc.def_coords,
  convert S.definable_external_prod dX dY,
  refine set.ext (finvec.rec (λ v w, _)),
  simp [finvec.append.inj_iff, finvec.append_mem_prod_iff]
end

end struc.def_coords

end o_minimal


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module init.data.unsigned.basic
! leanprover-community/mathlib commit 9e76153313954b399b860a365081d803e6ed2bf8
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Fin.Basic

open Nat

def unsignedSz : Nat :=
  succ 4294967295
#align unsigned_sz unsignedSz

def Unsigned :=
  Fin unsignedSz
#align unsigned Unsigned

namespace Unsigned

-- We cannot use tactic dec_trivial here because the tactic framework has not been defined yet.
private theorem zero_lt_unsigned_sz : 0 < unsignedSz :=
  zero_lt_succ _
#align unsigned.zero_lt_unsigned_sz unsigned.zero_lt_unsigned_sz

-- Later, we define of_nat using mod, the following version is used to define the metaprogramming system.
protected def ofNat' (n : Nat) : Unsigned :=
  if h : n < unsignedSz then ⟨n, h⟩ else ⟨0, zero_lt_unsignedSz⟩
#align unsigned.of_nat' Unsigned.ofNat'

def toNat (c : Unsigned) : Nat :=
  c.val
#align unsigned.to_nat Unsigned.toNat

end Unsigned

instance : DecidableEq Unsigned :=
  have : DecidableEq (Fin unsignedSz) := Fin.decidableEq _
  this


/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz
-/
import category_theory.sites.sheafification
import category_theory.sites.whiskering

/-!

In this file, we prove that the plus functor is compatible with functors which
preserve the correct limits and colimits.

See `category_theory/sites/compatible_sheafification` for the compatibility
of sheafification, which follows easily from the content in this file.

-/

namespace category_theory.grothendieck_topology

open category_theory
open category_theory.limits
open opposite

universes w₁ w₂ v u
variables {C : Type u} [category.{v} C] (J : grothendieck_topology C)
variables {D : Type w₁} [category.{max v u} D]
variables {E : Type w₂} [category.{max v u} E]
variables (F : D ⥤ E)

noncomputable theory

variables [∀ (α β : Type (max v u)) (fst snd : β → α),
  has_limits_of_shape (walking_multicospan fst snd) D]
variables [∀ (α β : Type (max v u)) (fst snd : β → α),
  has_limits_of_shape (walking_multicospan fst snd) E]
variables [∀ (X : C) (W : J.cover X) (P : Cᵒᵖ ⥤ D), preserves_limit (W.index P).multicospan F]

variables (P : Cᵒᵖ ⥤ D)

/-- The diagram used to define `P⁺`, composed with `F`, is isomorphic
to the diagram used to define `P ⋙ F`. -/
def diagram_comp_iso (X : C) : J.diagram P X ⋙ F ≅ J.diagram (P ⋙ F) X :=
nat_iso.of_components
(λ W, begin
  refine _ ≪≫ has_limit.iso_of_nat_iso (W.unop.multicospan_comp _ _).symm,
  refine (is_limit_of_preserves F (limit.is_limit _)).cone_point_unique_up_to_iso
    (limit.is_limit _)
end) begin
  intros A B f,
  ext,
  dsimp,
  simp only [functor.map_cone_π_app, multiequalizer.multifork_π_app_left,
    iso.symm_hom, multiequalizer.lift_ι, eq_to_hom_refl, category.comp_id,
    limit.cone_point_unique_up_to_iso_hom_comp,
    grothendieck_topology.cover.multicospan_comp_hom_inv_left,
    has_limit.iso_of_nat_iso_hom_π, category.assoc],
  simp only [← F.map_comp, multiequalizer.lift_ι],
end

@[simp, reassoc]
lemma diagram_comp_iso_hom_ι (X : C) (W : (J.cover X)ᵒᵖ) (i : W.unop.arrow):
  (J.diagram_comp_iso F P X).hom.app W ≫ multiequalizer.ι _ i =
  F.map (multiequalizer.ι _ _) :=
begin
  delta diagram_comp_iso,
  dsimp,
  simp,
end

variables [∀ (X : C), has_colimits_of_shape (J.cover X)ᵒᵖ D]
variables [∀ (X : C), has_colimits_of_shape (J.cover X)ᵒᵖ E]
variables [∀ (X : C), preserves_colimits_of_shape (J.cover X)ᵒᵖ F]

/-- The isomorphism between `P⁺ ⋙ F` and `(P ⋙ F)⁺`. -/
def plus_comp_iso : J.plus_obj P ⋙ F ≅ J.plus_obj (P ⋙ F) :=
nat_iso.of_components
(λ X, begin
  refine _ ≪≫ has_colimit.iso_of_nat_iso (J.diagram_comp_iso F P X.unop),
  refine (is_colimit_of_preserves F (colimit.is_colimit
    (J.diagram P (unop X)))).cocone_point_unique_up_to_iso (colimit.is_colimit _)
end) begin
  intros X Y f,
  apply (is_colimit_of_preserves F (colimit.is_colimit (J.diagram P X.unop))).hom_ext,
  intros W,
  dsimp [plus_obj, plus_map],
  simp only [functor.map_comp, category.assoc],
  slice_rhs 1 2
  { erw (is_colimit_of_preserves F (colimit.is_colimit (J.diagram P X.unop))).fac },
  slice_lhs 1 3
  { simp only [← F.map_comp],
    dsimp [colim_map, is_colimit.map, colimit.pre],
    simp only [colimit.ι_desc_assoc, colimit.ι_desc],
    dsimp [cocones.precompose],
    rw [category.assoc, colimit.ι_desc],
    dsimp [cocone.whisker],
    rw F.map_comp },
  simp only [category.assoc],
  slice_lhs 2 3
  { erw (is_colimit_of_preserves F (colimit.is_colimit (J.diagram P Y.unop))).fac },
  dsimp,
  simp only [has_colimit.iso_of_nat_iso_ι_hom_assoc,
    grothendieck_topology.diagram_pullback_app, colimit.ι_pre,
    has_colimit.iso_of_nat_iso_ι_hom, ι_colim_map_assoc],
  simp only [← category.assoc],
  congr' 1,
  ext,
  dsimp,
  simp only [category.assoc],
  erw [multiequalizer.lift_ι, diagram_comp_iso_hom_ι, diagram_comp_iso_hom_ι,
    ← F.map_comp, multiequalizer.lift_ι],
end

@[simp, reassoc]
lemma ι_plus_comp_iso_hom (X) (W) : F.map (colimit.ι _ W) ≫ (J.plus_comp_iso F P).hom.app X =
  (J.diagram_comp_iso F P X.unop).hom.app W ≫ colimit.ι _ W :=
begin
  delta diagram_comp_iso plus_comp_iso,
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  simp only [← category.assoc],
  erw (is_colimit_of_preserves F (colimit.is_colimit (J.diagram P (unop X)))).fac,
  dsimp,
  simp,
end

@[simp, reassoc]
lemma plus_comp_iso_whisker_left {F G : D ⥤ E} (η : F ⟶ G) (P : Cᵒᵖ ⥤ D)
  [∀ (X : C), preserves_colimits_of_shape (J.cover X)ᵒᵖ F]
  [∀ (X : C) (W : J.cover X) (P : Cᵒᵖ ⥤ D), preserves_limit (W.index P).multicospan F]
  [∀ (X : C), preserves_colimits_of_shape (J.cover X)ᵒᵖ G]
  [∀ (X : C) (W : J.cover X) (P : Cᵒᵖ ⥤ D), preserves_limit (W.index P).multicospan G] :
  whisker_left _ η ≫ (J.plus_comp_iso G P).hom =
  (J.plus_comp_iso F P).hom ≫ J.plus_map (whisker_left _ η) :=
begin
  ext X,
  apply (is_colimit_of_preserves F (colimit.is_colimit (J.diagram P X.unop))).hom_ext,
  intros W,
  dsimp [plus_obj, plus_map],
  simp only [ι_plus_comp_iso_hom, ι_colim_map, whisker_left_app, ι_plus_comp_iso_hom_assoc,
    nat_trans.naturality_assoc, grothendieck_topology.diagram_nat_trans_app],
  simp only [← category.assoc],
  congr' 1,
  ext,
  dsimp,
  simpa,
end

/-- The isomorphism between `P⁺ ⋙ F` and `(P ⋙ F)⁺`, functorially in `F`. -/
@[simps hom_app inv_app]
def plus_functor_whisker_left_iso (P : Cᵒᵖ ⥤ D)
  [∀ (F : D ⥤ E) (X : C), preserves_colimits_of_shape (J.cover X)ᵒᵖ F]
  [∀ (F : D ⥤ E) (X : C) (W : J.cover X) (P : Cᵒᵖ ⥤ D),
    preserves_limit (W.index P).multicospan F] :
  (whiskering_left _ _ E).obj (J.plus_obj P) ≅
  (whiskering_left _ _ _).obj P ⋙ J.plus_functor E :=
nat_iso.of_components
(λ X, plus_comp_iso _ _ _) $ λ F G η, plus_comp_iso_whisker_left _ _ _

@[simp, reassoc]
lemma plus_comp_iso_whisker_right {P Q : Cᵒᵖ ⥤ D} (η : P ⟶ Q) :
  whisker_right (J.plus_map η) F ≫ (J.plus_comp_iso F Q).hom =
  (J.plus_comp_iso F P).hom ≫ J.plus_map (whisker_right η F) :=
begin
  ext X,
  apply (is_colimit_of_preserves F (colimit.is_colimit (J.diagram P X.unop))).hom_ext,
  intros W,
  dsimp [plus_obj, plus_map],
  simp only [ι_colim_map, whisker_right_app, ι_plus_comp_iso_hom_assoc,
    grothendieck_topology.diagram_nat_trans_app],
  simp only [← category.assoc, ← F.map_comp],
  dsimp [colim_map, is_colimit.map],
  simp only [colimit.ι_desc],
  dsimp [cocones.precompose],
  simp only [functor.map_comp, category.assoc, ι_plus_comp_iso_hom],
  simp only [← category.assoc],
  congr' 1,
  ext,
  dsimp,
  simp only [diagram_comp_iso_hom_ι_assoc, multiequalizer.lift_ι,
    diagram_comp_iso_hom_ι, category.assoc],
  simp only [← F.map_comp, multiequalizer.lift_ι],
end

/-- The isomorphism between `P⁺ ⋙ F` and `(P ⋙ F)⁺`, functorially in `P`. -/
@[simps hom_app inv_app]
def plus_functor_whisker_right_iso : J.plus_functor D ⋙ (whiskering_right _ _ _).obj F ≅
  (whiskering_right _ _ _).obj F ⋙ J.plus_functor E :=
nat_iso.of_components (λ P, J.plus_comp_iso _ _) $ λ P Q η, plus_comp_iso_whisker_right _ _ _

@[simp, reassoc]
lemma whisker_right_to_plus_comp_plus_comp_iso_hom :
  whisker_right (J.to_plus _) _ ≫ (J.plus_comp_iso F P).hom = J.to_plus _ :=
begin
  ext,
  dsimp [to_plus],
  simp only [ι_plus_comp_iso_hom, functor.map_comp, category.assoc],
  simp only [← category.assoc],
  congr' 1,
  ext,
  delta cover.to_multiequalizer,
  simp only [diagram_comp_iso_hom_ι, category.assoc, ← F.map_comp],
  erw [multiequalizer.lift_ι, multiequalizer.lift_ι],
  refl,
end

@[simp]
lemma to_plus_comp_plus_comp_iso_inv : J.to_plus _ ≫ (J.plus_comp_iso F P).inv =
  whisker_right (J.to_plus _) _ :=
by simp [iso.comp_inv_eq]

lemma plus_comp_iso_inv_eq_plus_lift (hP : presheaf.is_sheaf J ((J.plus_obj P) ⋙ F)) :
  (J.plus_comp_iso F P).inv = J.plus_lift (whisker_right (J.to_plus _) _) hP :=
by { apply J.plus_lift_unique, simp [iso.comp_inv_eq] }

end category_theory.grothendieck_topology


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.sums.basic

/-!
# Associator for binary disjoint union of categories.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

The associator functor `((C ⊕ D) ⊕ E) ⥤ (C ⊕ (D ⊕ E))` and its inverse form an equivalence.
-/

universes v u

open category_theory
open sum

namespace category_theory.sum

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

/--
The associator functor `(C ⊕ D) ⊕ E ⥤ C ⊕ (D ⊕ E)` for sums of categories.
-/
def associator : (C ⊕ D) ⊕ E ⥤ C ⊕ (D ⊕ E) :=
{ obj := λ X, match X with
  | inl (inl X) := inl X
  | inl (inr X) := inr (inl X)
  | inr X := inr (inr X)
  end,
  map := λ X Y f, match X, Y, f with
  | inl (inl X), inl (inl Y), f := f
  | inl (inr X), inl (inr Y), f := f
  | inr X, inr Y, f := f
  end }

@[simp] lemma associator_obj_inl_inl (X) : (associator C D E).obj (inl (inl X)) = inl X := rfl
@[simp] lemma associator_obj_inl_inr (X) : (associator C D E).obj (inl (inr X)) = inr (inl X) := rfl
@[simp] lemma associator_obj_inr (X) : (associator C D E).obj (inr X) = inr (inr X) := rfl
@[simp] lemma associator_map_inl_inl {X Y : C} (f : inl (inl X) ⟶ inl (inl Y)) :
  (associator C D E).map f = f := rfl
@[simp] lemma associator_map_inl_inr {X Y : D} (f : inl (inr X) ⟶ inl (inr Y)) :
  (associator C D E).map f = f := rfl
@[simp] lemma associator_map_inr {X Y : E} (f : inr X ⟶ inr Y) :
  (associator C D E).map f = f := rfl

/--
The inverse associator functor `C ⊕ (D ⊕ E) ⥤ (C ⊕ D) ⊕ E` for sums of categories.
-/
def inverse_associator : C ⊕ (D ⊕ E) ⥤ (C ⊕ D) ⊕ E :=
{ obj := λ X, match X with
  | inl X := inl (inl X)
  | inr (inl X) := inl (inr X)
  | inr (inr X) := inr X
  end,
  map := λ X Y f, match X, Y, f with
  | inl X, inl Y, f := f
  | inr (inl X), inr (inl Y), f := f
  | inr (inr X), inr (inr Y), f := f
  end }

@[simp] lemma inverse_associator_obj_inl (X) :
  (inverse_associator C D E).obj (inl X) = inl (inl X) := rfl
@[simp] lemma inverse_associator_obj_inr_inl (X) :
  (inverse_associator C D E).obj (inr (inl X)) = inl (inr X) := rfl
@[simp] lemma inverse_associator_obj_inr_inr (X) :
  (inverse_associator C D E).obj (inr (inr X)) = inr X := rfl
@[simp]

/--
The equivalence of categories expressing associativity of sums of categories.
-/
def associativity : (C ⊕ D) ⊕ E ≌ C ⊕ (D ⊕ E) :=
equivalence.mk (associator C D E) (inverse_associator C D E)
  (nat_iso.of_components (λ X, eq_to_iso (by tidy)) (by tidy))
  (nat_iso.of_components (λ X, eq_to_iso (by tidy)) (by tidy))

instance associator_is_equivalence : is_equivalence (associator C D E) :=
(by apply_instance : is_equivalence (associativity C D E).functor)

instance inverse_associator_is_equivalence : is_equivalence (inverse_associator C D E) :=
(by apply_instance : is_equivalence (associativity C D E).inverse)

-- TODO unitors?
-- TODO pentagon natural transformation? ...satisfying?
end category_theory.sum


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.functor
import Mathlib.PostPort

universes v₁ v₂ u₁ u₂ l u₃ v₃

namespace Mathlib

/-!
# Unbundled functors, as a typeclass decorating the object-level function.
-/

namespace category_theory

/-- A unbundled functor. -/
-- Perhaps in the future we could redefine `functor` in terms of this, but that isn't the

-- immediate plan.

class functorial {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C → D)
where
  map : {X Y : C} → (X ⟶ Y) → (F X ⟶ F Y)
  map_id' : autoParam (C → map 𝟙 = 𝟙)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  map_comp' : autoParam (∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = map f ≫ map g)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

/--
If `F : C → D` (just a function) has `[functorial F]`,
we can write `map F f : F X ⟶ F Y` for the action of `F` on a morphism `f : X ⟶ Y`.
-/
def map {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C → D) [functorial F] {X : C} {Y : C} (f : X ⟶ Y) : F X ⟶ F Y :=
  functorial.map f

@[simp] theorem map_as_map {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C → D} [functorial F] {X : C} {Y : C} {f : X ⟶ Y} : functorial.map f = map F f :=
  rfl

@[simp] theorem functorial.map_id {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C → D} [functorial F] {X : C} : map F 𝟙 = 𝟙 :=
  functorial.map_id' X

@[simp] theorem functorial.map_comp {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C → D} [functorial F] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} : map F (f ≫ g) = map F f ≫ map F g :=
  functorial.map_comp' f g

namespace functor

/--
Bundle a functorial function as a functor.
-/
def of {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C → D) [I : functorial F] : C ⥤ D :=
  mk F functorial.map

end functor

protected instance functor.obj.functorial {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) : functorial (functor.obj F) :=
  functorial.mk (functor.map F)

@[simp] theorem map_functorial_obj {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) {X : C} {Y : C} (f : X ⟶ Y) : map (functor.obj F) f = functor.map F f :=
  rfl

protected instance functorial_id {C : Type u₁} [category C] : functorial id :=
  functorial.mk fun (X Y : C) (f : X ⟶ Y) => f

/--
`G ∘ F` is a functorial if both `F` and `G` are.
-/
-- This is no longer viable as an instance in Lean 3.7,

-- #lint reports an instance loop

-- Will this be a problem?

def functorial_comp {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E] (F : C → D) [functorial F] (G : D → E) [functorial G] : functorial (G ∘ F) :=
  functorial.mk (functor.map (functor.of F ⋙ functor.of G))


import category_theory.adjunction.basic
import category_theory.types

open category_theory category_theory.category category_theory.functor category_theory.adjunction

universes v u

noncomputable theory

variables {C D : Type u} [category.{v} C] [category.{v} D] (L : C ⥤ D) (R : D ⥤ C)

/-
  Some more results about adjucntion. We promote any adjunction to a natural
  isomomorphism between hom functors, and we promote such iso to an adjunction
-/

open opposite

-- (c, d) --> C(c, Rd)
def right_hom : Cᵒᵖ × D ⥤ Type v :=
{ obj := λ x, (x.1.unop ⟶ R.obj x.2),
  map := λ _ _ f g, f.fst.unop ≫ g ≫ R.map f.snd,
  map_id' := λ x,
    by {funext, rw [prod_id_fst, prod_id_snd, unop_id, id_comp, map_id, comp_id], refl},
  map_comp' := λ _ _ _ f g, by tidy }

-- (c, d) --> D(Lc, d)
def left_hom : Cᵒᵖ × D ⥤ Type v :=
{ obj := λ x, (L.obj x.1.unop ⟶ x.2),
  map := λ _ _ f g, L.map f.fst.unop ≫ g ≫ f.snd,
  map_id' := λ x,
    by {funext, rw [prod_id_fst, prod_id_snd, unop_id, map_id, id_comp, comp_id], refl},
  map_comp' := λ _ _ _ f g, by tidy }

@[simp] lemma left_hom_obj (x : Cᵒᵖ × D) : (left_hom L).obj x = (L.obj x.1.unop ⟶ x.2) := rfl
@[simp] lemma right_hom_obj (x : Cᵒᵖ × D) : (right_hom R).obj x = (x.1.unop ⟶ R.obj x.2) := rfl

lemma left_hom_map {x y : Cᵒᵖ × D} (f : x ⟶ y) (g : (left_hom L).obj x) :
  (left_hom L).map f g = L.map f.fst.unop ≫ g ≫ f.snd := rfl
lemma right_hom_map {x y : Cᵒᵖ × D} (f : x ⟶ y) (g : (right_hom R).obj x) :
  (right_hom R).map f g = f.fst.unop ≫ g ≫ R.map f.snd := rfl

variables {L R}

lemma left_hom_iso_right_hom_of_adjunction (adj : L ⊣ R) : left_hom L ≅ right_hom R   :=
nat_iso.of_components
  (λ x, (equiv.to_iso (adj.hom_equiv x.1.unop x.2) : (left_hom L).obj x ≅ (right_hom R).obj x))
  (begin  intros x y f,
    ext g, simp,
    rw [left_hom_map, map_comp, ←assoc, unit_naturality adj, map_comp, right_hom_map],
    simp only [assoc]
   end)

def core_adjunction_of_left_hom_iso_right (i : left_hom L ≅ right_hom R) :
  adjunction.core_hom_equiv L R :=
{ hom_equiv := λ x y, iso.to_equiv (i.app (op x, y)),
  hom_equiv_naturality_left_symm' :=
  begin
    intros c c' d f g, simp,
    convert congr_fun (i.inv.naturality ((f.op, 𝟙 d) : (op c', d) ⟶ (op c, d))) g; simp,
  end,
  hom_equiv_naturality_right' :=
  begin
    intros c d d' f g, simp,
    have g' := congr_fun (i.hom.naturality ((𝟙 (op c), g) : (op c, d) ⟶ (op c, d'))) f,
    simp at g', rw [left_hom_map, right_hom_map] at g',
    simp at g', rw [L.map_id c, id_comp (f ≫ g)] at g',
    rw g', apply id_comp,
  end }

def adjunction_of_left_hom_iso_right (i : left_hom L ≅ right_hom R) : L ⊣ R :=
mk_of_hom_equiv (core_adjunction_of_left_hom_iso_right i)


variables (f : ℕ → ℕ) (k : ℕ)

example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
  by simp [h₁, h₂]


import topology.uniform_space.cauchy
import topology.algebra.uniform_group
import for_mathlib.topological_groups

open filter set

local infixr ` ×ᶠ `:51 := filter.prod
local notation `𝓤` := uniformity
local notation `𝓝` x:70 := nhds x

section
open tactic
meta def clean_step : tactic unit :=
do tgt ← target,
   match tgt with
   | `(%%a → %%b) := `[intros]
   | `(%%a ↔ %%b) := match a with
                     | `(%%c → %%d) := if c.has_var then `[apply imp_congr] else `[apply forall_congr]
                     | `(Exists %%c) := `[apply exists_congr]
                     | _ := `[exact iff.rfl]
                     end
   | _ := fail "Goal is not a forall, implies or iff"
   end

meta def tactic.interactive.clean_iff : tactic unit := do repeat clean_step
end

variables (α : Type*) [uniform_space α] [add_group α] [uniform_add_group α]

lemma add_group_filter_basis.cauchy_iff {B : add_group_filter_basis α}
  (h : uniform_space.to_topological_space α = B.topology) {F : filter α} :
  cauchy F ↔ F ≠ ⊥ ∧ ∀ U ∈ B, ∃ M ∈ F, ∀ x y ∈ M, y - x ∈ U :=
begin
  suffices : F ×ᶠ F ≤ 𝓤 α ↔ ∀ U ∈ B, ∃ M ∈ F, ∀ x y ∈ M, y - x ∈ U,
    by split ; rintros ⟨h', h⟩ ; refine ⟨h', _⟩ ; [rwa ← this, rwa this],
  rw [uniformity_eq_comap_nhds_zero α, ← map_le_iff_le_comap],
  change tendsto _ _ _ ↔ _,
  rw [B.nhds_zero_eq h, filter_basis.tendsto_into],
  simp only [mem_prod_same_iff],
  clean_iff,
  rw [subset_def, prod.forall],
  clean_iff,
  rw [prod_mk_mem_set_prod_eq],
  tauto!
end

lemma test {α : Type*} [has_sub α] (S T : set $ set α) :
 (∀ {V : set α}, V ∈ S → (∃ (t : set α) (H : t ∈ T), set.prod t t ⊆ (λ (x : α × α), x.snd - x.fst) ⁻¹' V)) ↔
    ∀ (U : set α), U ∈ S → (∃ (M : set α) (H : M ∈ T), ∀ (x y : α), x ∈ M → y ∈ M → y - x ∈ U) :=
begin
  clean_iff,
  rw [subset_def, prod.forall],
  clean_iff,
  rw [set.prod_mk_mem_set_prod_eq],
  tauto!
end


/- In-memory representation of values. -/

import .ast .integers .values

namespace memdata
open ast integers values word floats
     ast.memory_chunk

inductive quantity : Type | Q32 | Q64
open quantity

instance quantity_eq : decidable_eq quantity := by tactic.mk_dec_eq_instance

def quantity.size : quantity → ℕ
| Q32 := 4
| Q64 := 8

lemma quantity.size_pos (q : quantity) : q.size > 0 :=
by cases q; exact dec_trivial

/- * Memory values -/

/- A ``memory value'' is a byte-sized quantity that describes the current
  content of a memory cell.  It can be either:
- a concrete 8-bit integer;
- a byte-sized fragment of an opaque value;
- the special constant [Undef] that represents uninitialized memory.
-/

/- Values stored in memory cells. -/

inductive memval : Type
| Undef : memval
| Byte : byte → memval
| Fragment : val → quantity → nat → memval.
open memval

/- * Encoding and decoding integers -/

/- We define functions to convert between integers and lists of bytes
  of a given length -/

def rev_if_be (l : list byte) : list byte :=
if archi.big_endian then l.reverse else l

def encode_int (sz : ℕ) (x : ℤ) : list byte :=
rev_if_be (words_of_int sz x)

def decode_int (b : list byte) : ℕ :=
nat_of_words (rev_if_be b)

/- Length properties -/

@[simp] lemma rev_if_be_length (l) : (rev_if_be l).length = l.length :=
by delta rev_if_be; by_cases (archi.big_endian : Prop); simp [h]

@[simp] lemma encode_int_length (sz x) : (encode_int sz x).length = sz :=
by simp [encode_int]

/- Decoding after encoding -/

lemma rev_if_be_involutive (l) : rev_if_be (rev_if_be l) = l :=
by delta rev_if_be; by_cases (archi.big_endian : Prop); simp [h]

lemma decode_encode_int (n x) : decode_int (encode_int n x) = x.nat_mod (2^(n * 8)) :=
by simp [decode_int, encode_int, rev_if_be_involutive]; refl

lemma decode_encode_int_1 (x : int32) :
  repr (decode_int (encode_int 1 (unsigned x))) = zero_ext 8 x := sorry'

lemma decode_encode_int_2 (x : int32) :
  repr (decode_int (encode_int 2 (unsigned x))) = zero_ext 16 x := sorry'

lemma decode_encode_int_4 (x : int32) :
  repr (decode_int (encode_int 4 (unsigned x))) = x := sorry'

lemma decode_encode_int_8 (x : int64) :
  repr (decode_int (encode_int 8 (unsigned x))) = x := sorry'

/- A length-[n] encoding depends only on the low [8*n] bits of the integer. -/

lemma encode_int_mod (n) {x y} (h : (repr x : word (8*n)) = repr y) :
  encode_int n x = encode_int n y :=
by dsimp [encode_int]; rw words_of_int_mod _ (mod_eq_of_repr_eq h)

lemma encode_int_8_mod (x y) : (repr x : byte) = repr y →
  encode_int 1 x = encode_int 1 y :=
encode_int_mod 1

lemma encode_int_16_mod (x y) : (repr x : word 16) = repr y →
  encode_int 2 x = encode_int 2 y :=
encode_int_mod 2

/- * Encoding and decoding values -/

def inj_bytes (bl : list byte) : list memval :=
bl.map Byte

def proj_bytes : list memval → option (list byte)
| []              := some []
| (Byte b :: vl') := list.cons b <$> proj_bytes vl'
| _               := none

theorem length_inj_bytes (bl) : (inj_bytes bl).length = bl.length :=
list.length_map _ _

theorem proj_inj_bytes (bl) : proj_bytes (inj_bytes bl) = some bl :=
begin
  simp [inj_bytes],
  induction bl with b bl IH; simp [inj_bytes, proj_bytes],
  simp [IH], refl
end

lemma inj_proj_bytes (cl bl) : proj_bytes cl = some bl → cl = inj_bytes bl := sorry'

def inj_value_rec (v : val) (q : quantity) : ℕ → list memval
| 0 := []
| (m + 1) := Fragment v q m :: inj_value_rec m

def inj_value (q : quantity) (v : val) : list memval :=
inj_value_rec v q q.size

def check_value (v : val) (q : quantity) : ℕ → list memval → bool
| 0 [] := tt
| (m + 1) (Fragment v' q' m' :: vl') :=
  v = v' ∧ q = q' ∧ m = m' ∧ check_value m vl'
| _ _ := ff

def proj_value (q : quantity) (vl : list memval) : val :=
match vl with
| Fragment v q' n :: vl' :=
      if check_value v q q.size vl then v else Vundef
| _ := Vundef
end

def encode_val : memory_chunk → val → list memval
| Mint8signed    (Vint n)     := inj_bytes (encode_int 1 (unsigned n))
| Mint8unsigned  (Vint n)     := inj_bytes (encode_int 1 (unsigned n))
| Mint16signed   (Vint n)     := inj_bytes (encode_int 2 (unsigned n))
| Mint16unsigned (Vint n)     := inj_bytes (encode_int 2 (unsigned n))
| Mint32         (Vint n)     := inj_bytes (encode_int 4 (unsigned n))
| Mint32         (Vptr b ofs) := if archi.ptr64 then list.repeat Undef 4 else inj_value Q32 (Vptr b ofs)
| Mint64         (Vlong n)    := inj_bytes (encode_int 8 (unsigned n))
| Mint64         (Vptr b ofs) := if archi.ptr64 then inj_value Q64 (Vptr b ofs) else list.repeat Undef 8
| Mfloat32       (Vsingle n)  := inj_bytes (encode_int 4 (unsigned n.to_bits))
| Mfloat64       (Vfloat n)   := inj_bytes (encode_int 8 (unsigned n.to_bits))
| Many32         v            := inj_value Q32 v
| Many64         v            := inj_value Q64 v
| chunk          _            := list.repeat Undef chunk.size

def decode_val (chunk : memory_chunk) (vl : list memval) : val :=
match proj_bytes vl, chunk with
| some bl, Mint8signed    := Vint (sign_ext W8 (repr (decode_int bl)))
| some bl, Mint8unsigned  := Vint (zero_ext 8 (repr (decode_int bl)))
| some bl, Mint16signed   := Vint (sign_ext W16 (repr (decode_int bl)))
| some bl, Mint16unsigned := Vint (zero_ext 16 (repr (decode_int bl)))
| some bl, Mint32         := Vint (repr (decode_int bl))
| some bl, Mint64         := Vlong (repr (decode_int bl))
| some bl, Mfloat32       := float32.of_bits (repr (decode_int bl))
| some bl, Mfloat64       := float.of_bits (repr (decode_int bl))
| some bl, Many32         := Vundef
| some bl, Many64         := Vundef
| none,    Mint32         := if archi.ptr64 then Vundef else val.load_result chunk (proj_value Q32 vl)
| none,    Many32         := val.load_result chunk (proj_value Q32 vl)
| none,    Mint64         := if archi.ptr64 then val.load_result chunk (proj_value Q64 vl) else Vundef
| none,    Many64         := val.load_result chunk (proj_value Q64 vl)
| none,    _              := Vundef
end

lemma encode_val_length (chunk v) : (encode_val chunk v).length = chunk.size := sorry'

lemma check_inj_value (v q n) : check_value v q n (inj_value_rec v q n) := sorry'

lemma proj_inj_value (q v) : proj_value q (inj_value q v) = v := sorry'

theorem in_inj_value (mv v q) : mv ∈ inj_value q v → ∃ n, mv = Fragment v q n := sorry'

lemma proj_inj_value_mismatch (q1 q2 v) : q1 ≠ q2 → proj_value q1 (inj_value q2 v) = Vundef := sorry'

def decode_encode_val : val → memory_chunk → memory_chunk → val → Prop
| (Vundef)      _               _               v2 := v2 = Vundef
| (Vint n)      Mint8signed     Mint8signed     v2 := v2 = Vint (sign_ext W8 n)
| (Vint n)      Mint8unsigned   Mint8signed     v2 := v2 = Vint (sign_ext W8 n)
| (Vint n)      Mint8signed     Mint8unsigned   v2 := v2 = Vint (zero_ext 8 n)
| (Vint n)      Mint8unsigned   Mint8unsigned   v2 := v2 = Vint (zero_ext 8 n)
| (Vint n)      Mint16signed    Mint16signed    v2 := v2 = Vint (sign_ext W16 n)
| (Vint n)      Mint16unsigned  Mint16signed    v2 := v2 = Vint (sign_ext W16 n)
| (Vint n)      Mint16signed    Mint16unsigned  v2 := v2 = Vint (zero_ext 16 n)
| (Vint n)      Mint16unsigned  Mint16unsigned  v2 := v2 = Vint (zero_ext 16 n)
| (Vint n)      Mint32          Mint32          v2 := v2 = Vint n
| (Vint n)      Many32          Many32          v2 := v2 = Vint n
| (Vint n)      Mint32          Mfloat32        v2 := v2 = float32.of_bits n
| (Vint n)      Many64          Many64          v2 := v2 = Vint n
| (Vint n)      Mint64          _               v2 := v2 = Vundef
| (Vint n)      Mfloat32        _               v2 := v2 = Vundef
| (Vint n)      Mfloat64        _               v2 := v2 = Vundef
| (Vint n)      Many64          _               v2 := v2 = Vundef
| (Vint n)      _               _               v2 := true /- nothing meaningful to say about v2 -/
| (Vptr b ofs)  Mint32          Mint32          v2 := v2 = if archi.ptr64 then Vundef else Vptr b ofs
| (Vptr b ofs)  Mint32          Many32          v2 := v2 = if archi.ptr64 then Vundef else Vptr b ofs
| (Vptr b ofs)  Many32          Mint32          v2 := v2 = if archi.ptr64 then Vundef else Vptr b ofs
| (Vptr b ofs)  Many32          Many32          v2 := v2 = if archi.ptr64 then Vundef else Vptr b ofs
| (Vptr b ofs)  Mint64          Mint64          v2 := v2 = if archi.ptr64 then Vptr b ofs else Vundef
| (Vptr b ofs)  Mint64          Many64          v2 := v2 = if archi.ptr64 then Vptr b ofs else Vundef
| (Vptr b ofs)  Many64          Many64          v2 := v2 = Vptr b ofs
| (Vptr b ofs)  Many64          Mint64          v2 := v2 = if archi.ptr64 then Vptr b ofs else Vundef
| (Vptr b ofs)  _               _               v2 := v2 = Vundef
| (Vlong n)     Mint64          Mint64          v2 := v2 = Vlong n
| (Vlong n)     Mint64          Mfloat64        v2 := v2 = float.of_bits n
| (Vlong n)     Many64          Many64          v2 := v2 = Vlong n
| (Vlong n)     Mint8signed     _               v2 := v2 = Vundef
| (Vlong n)     Mint8unsigned   _               v2 := v2 = Vundef
| (Vlong n)     Mint16signed    _               v2 := v2 = Vundef
| (Vlong n)     Mint16unsigned  _               v2 := v2 = Vundef
| (Vlong n)     Mint32          _               v2 := v2 = Vundef
| (Vlong n)     Mfloat32        _               v2 := v2 = Vundef
| (Vlong n)     Mfloat64        _               v2 := v2 = Vundef
| (Vlong n)     Many32          _               v2 := v2 = Vundef
| (Vlong n)     _               _               v2 := true /- nothing meaningful to say about v2 -/
| (Vfloat f)    Mfloat64        Mfloat64        v2 := v2 = Vfloat f
| (Vfloat f)    Mfloat64        Mint64          v2 := v2 = float.to_bits f
| (Vfloat f)    Many64          Many64          v2 := v2 = Vfloat f
| (Vfloat f)    Mint8signed     _               v2 := v2 = Vundef
| (Vfloat f)    Mint8unsigned   _               v2 := v2 = Vundef
| (Vfloat f)    Mint16signed    _               v2 := v2 = Vundef
| (Vfloat f)    Mint16unsigned  _               v2 := v2 = Vundef
| (Vfloat f)    Mint32          _               v2 := v2 = Vundef
| (Vfloat f)    Mfloat32        _               v2 := v2 = Vundef
| (Vfloat f)    Mint64          _               v2 := v2 = Vundef
| (Vfloat f)    Many32          _               v2 := v2 = Vundef
| (Vfloat f)    _               _               v2 := true   /- nothing interesting to say about v2 -/
| (Vsingle f)   Mfloat32        Mfloat32        v2 := v2 = Vsingle f
| (Vsingle f)   Mfloat32        Mint32          v2 := v2 = float32.to_bits f
| (Vsingle f)   Many32          Many32          v2 := v2 = Vsingle f
| (Vsingle f)   Many64          Many64          v2 := v2 = Vsingle f
| (Vsingle f)   Mint8signed     _               v2 := v2 = Vundef
| (Vsingle f)   Mint8unsigned   _               v2 := v2 = Vundef
| (Vsingle f)   Mint16signed    _               v2 := v2 = Vundef
| (Vsingle f)   Mint16unsigned  _               v2 := v2 = Vundef
| (Vsingle f)   Mint32          _               v2 := v2 = Vundef
| (Vsingle f)   Mint64          _               v2 := v2 = Vundef
| (Vsingle f)   Mfloat64        _               v2 := v2 = Vundef
| (Vsingle f)   Many64          _               v2 := v2 = Vundef
| (Vsingle f)   _               _               v2 := true /- nothing interesting to say about v2 -/

theorem decode_val_undef (bl chunk) : decode_val chunk (Undef :: bl) = Vundef := sorry'

theorem proj_bytes_inj_value (q v) : proj_bytes (inj_value q v) = none := sorry'

lemma decode_encode_val_general (v chunk1 chunk2) :
  decode_encode_val v chunk1 chunk2 (decode_val chunk2 (encode_val chunk1 v)) := sorry'

lemma decode_encode_val_similar {v1 chunk1 chunk2 v2} :
  decode_encode_val v1 chunk1 chunk2 v2 →
  chunk1.type = chunk2.type →
  chunk1.size = chunk2.size →
  v2 = val.load_result chunk2 v1 := sorry'

lemma decode_val_type (chunk cl) :
  val.has_type (decode_val chunk cl) chunk.type := sorry'

lemma encode_val_int8_signed_unsigned (v) : encode_val Mint8signed v = encode_val Mint8unsigned v := sorry'

lemma encode_val_int16_signed_unsigned (v) : encode_val Mint16signed v = encode_val Mint16unsigned v := sorry'

lemma encode_val_int8_zero_ext (n : int32) :
  encode_val Mint8unsigned (Vint (zero_ext 8 n)) = encode_val Mint8unsigned (Vint n) := sorry'

lemma encode_val_int8_sign_ext (n) :
  encode_val Mint8signed (Vint (sign_ext W8 n)) = encode_val Mint8signed (Vint n) := sorry'

lemma encode_val_int16_zero_ext (n) :
  encode_val Mint16unsigned (Vint (zero_ext 16 n)) = encode_val Mint16unsigned (Vint n) := sorry'

lemma encode_val_int16_sign_ext (n) :
  encode_val Mint16signed (Vint (sign_ext W16 n)) = encode_val Mint16signed (Vint n) := sorry'

lemma decode_val_cast_type (v : val) : memory_chunk → Prop
| Mint8signed    := v = val.sign_ext W8 v
| Mint8unsigned  := v = val.zero_ext 8 v
| Mint16signed   := v = val.sign_ext W16 v
| Mint16unsigned := v = val.zero_ext 16 v
| _              := true

lemma decode_val_cast (chunk l) : decode_val_cast_type (decode_val chunk l) chunk := sorry'

/- Pointers cannot be forged. -/

def quantity_chunk : memory_chunk → quantity
| Mint64   := Q64
| Mfloat64 := Q64
| Many64   := Q64
| _        := Q32

def shape_encoding.b.type : val → Prop
| (Vint _)    := true
| (Vlong _)   := true
| (Vfloat _)  := true
| (Vsingle _) := true
| _           := false

inductive shape_encoding (chunk : memory_chunk) (v : val) : list memval → Prop
| f (q i) : ∀ mvl,
      (chunk = Mint32 ∨ chunk = Many32 ∨ chunk = Mint64 ∨ chunk = Many64) →
      q = quantity_chunk chunk →
      i+1 = q.size →
      (∀ mv ∈ mvl, ∃ j, mv = Fragment v q j ∧ j+1 ≠ q.size) →
      shape_encoding (Fragment v q i :: mvl)
| b (b mvl) : memdata.shape_encoding.b.type v →
      (∀ mv ∈ mvl, ∃ b', mv = Byte b') → shape_encoding (Byte b :: mvl)
| u (mvl) : (∀ mv ∈ mvl, mv = Undef) → shape_encoding (Undef :: mvl)

lemma encode_val_shape (chunk v) : shape_encoding chunk v (encode_val chunk v) := sorry'

inductive shape_decoding (chunk : memory_chunk) : list memval → val → Prop
| f (v q i) : ∀ mvl,
      (chunk = Mint32 ∨ chunk = Many32 ∨ chunk = Mint64 ∨ chunk = Many64) →
      q = quantity_chunk chunk →
      i+1 = q.size →
      (∀ mv ∈ mvl, ∃ j, mv = Fragment v q j ∧ j+1 ≠ q.size) →
      shape_decoding (Fragment v q i :: mvl) (val.load_result chunk v)
| b (b mvl v) : shape_encoding.b.type v →
      (∀ mv ∈ mvl, ∃ b', mv = Byte b') →
      shape_decoding (Byte b :: mvl) v
| u (mvl) : shape_decoding mvl Vundef

lemma decode_val_shape (chunk mv1 mvl) :
  shape_decoding chunk (mv1 :: mvl) (decode_val chunk (mv1 :: mvl)) := sorry'

/- * Compatibility with memory injections -/

/- Relating two memory values according to a memory injection. -/

inductive memval_inject (f : meminj) : memval → memval → Prop
| byte (n) : memval_inject (Byte n) (Byte n)
| frag (v1 v2 q n) : inject f v1 v2 →
      memval_inject (Fragment v1 q n) (Fragment v2 q n)
| undef (mv) : memval_inject Undef mv

lemma memval_inject.incr (f f' v1 v2) :
  memval_inject f v1 v2 → inject_incr f f' → memval_inject f' v1 v2 := sorry'

/- [decode_val], applied to lists of memory values that are pairwise
  related by [memval_inject], returns values that are related by [inject]. -/

lemma proj_bytes_inject (f vl vl') :
  list.forall2 (memval_inject f) vl vl' →
  ∀ bl, proj_bytes vl = some bl → proj_bytes vl' = some bl := sorry'

lemma check_value_inject (f vl vl') :
  list.forall2 (memval_inject f) vl vl' →
  ∀ v v' q n,
  check_value v q n vl →
  inject f v v' → v ≠ Vundef →
  check_value v' q n vl' := sorry'

lemma proj_value_inject (f q vl1 vl2) :
  list.forall2 (memval_inject f) vl1 vl2 →
  inject f (proj_value q vl1) (proj_value q vl2) := sorry'

lemma proj_bytes_not_inject (f vl vl') :
  list.forall2 (memval_inject f) vl vl' →
  proj_bytes vl = none → proj_bytes vl' ≠ none → Undef ∈ vl := sorry'

lemma check_value_undef (n q v vl) :
  Undef ∈ vl → ¬ check_value v q n vl := sorry'

lemma proj_value_undef (q vl) : Undef ∈ vl → proj_value q vl = Vundef := sorry'

theorem decode_val_inject (f vl1 vl2 chunk) :
  list.forall2 (memval_inject f) vl1 vl2 →
  inject f (decode_val chunk vl1) (decode_val chunk vl2) := sorry'

/- Symmetrically, [encode_val], applied to values related by [inject],
  returns lists of memory values that are pairwise
  related by [memval_inject]. -/

lemma inj_bytes_inject (f bl) :
  list.forall2 (memval_inject f) (inj_bytes bl) (inj_bytes bl) := sorry'

lemma repeat_Undef_inject_any (f) (vl : list memval) :
  list.forall2 (memval_inject f) (list.repeat Undef vl.length) vl := sorry'

lemma repeat_Undef_inject_encode_val (f) (chunk : memory_chunk) (v) :
  list.forall2 (memval_inject f) (list.repeat Undef chunk.size) (encode_val chunk v) := sorry'

lemma repeat_Undef_inject_self (f n) :
  list.forall2 (memval_inject f) (list.repeat Undef n) (list.repeat Undef n) := sorry'

lemma inj_value_inject (f v1 v2 q) : inject f v1 v2 →
  list.forall2 (memval_inject f) (inj_value q v1) (inj_value q v2) := sorry'

theorem encode_val_inject (f v1 v2 chunk) : inject f v1 v2 →
  list.forall2 (memval_inject f) (encode_val chunk v1) (encode_val chunk v2) := sorry'

def memval_lessdef : memval → memval → Prop := memval_inject inject_id

lemma memval_lessdef_refl (mv) : memval_lessdef mv mv :=
by dsimp [memval_lessdef]; cases mv; constructor; apply val_inject_id.2; constructor

/- [memval_inject] and compositions -/

lemma memval_inject_compose {f f' v1 v2 v3} :
  memval_inject f v1 v2 → memval_inject f' v2 v3 →
  memval_inject (f.comp f') v1 v3 := sorry'

/- * Breaking 64-bit memory accesses into two 32-bit accesses -/

lemma length_proj_bytes {l b} : proj_bytes l = some b → b.length = l.length := sorry'

lemma proj_bytes_append (l2 l1) : proj_bytes (l1 ++ l2) =
  do b1 ← proj_bytes l1, b2 ← proj_bytes l2, some (b1 ++ b2) := sorry'

lemma decode_val_int64 {l1 l2 : list memval} : l1.length = 4 → l2.length = 4 → ¬ archi.ptr64 →
  lessdef (decode_val Mint64 (l1 ++ l2)) (long_of_words
    (decode_val Mint32 (if archi.big_endian then l1 else l2))
    (decode_val Mint32 (if archi.big_endian then l2 else l1))) := sorry'

lemma encode_val_int64 (v) : ¬ archi.ptr64 → encode_val Mint64 v =
     encode_val Mint32 (if archi.big_endian then hiword v else loword v)
  ++ encode_val Mint32 (if archi.big_endian then loword v else hiword v) := sorry'

end memdata


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import portmanteau_definitions
import portmanteau_topological_lemmas
import portmanteau_open_equiv_closed

noncomputable theory
open measure_theory

namespace portmanteau

section portmanteau_open_closed_implies_borel

variables {α : Type} [topological_space α]

lemma portmanteau_open_closed_imp_borel_cond
  (μseq : ℕ → @measure_theory.measure α (borel α)) (μ : @measure_theory.measure α (borel α)) :
    portmanteau_open μseq μ ∧ portmanteau_closed μseq μ
    → portmanteau_borel μseq μ :=
begin
  rintros ⟨ hopcond , hclcond ⟩ ,
  intros E hEborel hEnullbdry ,
  set Ecl := closure E with hEcl ,
  set Eint := interior E with hEint ,
  have h_E_subset_Ecl : E ⊆ Ecl := subset_closure ,
  have h_Eint_subset_E : Eint ⊆ E := interior_subset ,
  have ineq_E_le_Ecl := @measure_mono α (borel(α)) μ E Ecl subset_closure ,
  have ineq_E_le_Ecl_seq := (λ (n : ℕ) , @measure_mono α (borel(α)) (μseq(n)) E Ecl subset_closure ) ,
  have ineq_Eint_le_E := @measure_mono α (borel(α)) μ Eint E interior_subset ,
  have ineq_Eint_le_E_seq := (λ (n : ℕ) , @measure_mono α (borel(α)) (μseq(n)) Eint E interior_subset) ,
  have equalities := meas_eq_various_of_null_bdry μ E hEnullbdry ,
  have pt_limsup : limsup_enn (λ n , (μseq(n))(E)) ≤ μ(E) ,
  { calc limsup_enn (λ n , (μseq(n))(E))
        ≤ limsup_enn (λ n , (μseq(n))(Ecl))  : limsup_enn_mono ineq_E_le_Ecl_seq
    ... ≤ μ(Ecl)                             : hclcond Ecl is_closed_closure
    ... = μ(E)                               : by rw equalities.2 ,
    } ,
  have pt_liminf : μ(E) ≤ liminf_enn (λ n , (μseq(n))(E)) ,
  { calc μ(E) = μ(Eint)                      : by rw equalities.1
    ... ≤ liminf_enn (λ n , (μseq(n))(Eint)) : hopcond Eint is_open_interior
    ... ≤ liminf_enn (λ n , (μseq(n))(E))    : liminf_enn_mono ineq_Eint_le_E_seq ,
    } ,
  have key := lim_eq_liminf_of_limsup_le_liminf_ennreal (le_trans pt_limsup pt_liminf) ,
  suffices : liminf_enn (λ n , (μseq(n))(E)) = μ(E) ,
  { rw ← this ,
    exact key , } ,
  apply le_antisymm ,
  { exact le_trans (liminf_le_limsup_enn (λ n , (μseq(n))(E))) pt_limsup , } ,
  { exact pt_liminf , } ,
end

lemma portmanteau_open_imp_borel
  (μseq : ℕ → @measure_theory.measure α (borel α))
  (μseq_fin : ∀ (n : ℕ) , @probability_measure α (borel(α)) (μseq(n)))
  (μ : @measure_theory.measure α (borel α)) (μ_fin : @probability_measure α (borel(α)) μ) :
    portmanteau_open μseq μ → portmanteau_borel μseq μ :=
begin
  intros hopcond ,
  have hclcond := portmanteau_open_imp_closed_cond μseq μseq_fin μ μ_fin hopcond ,
  exact portmanteau_open_closed_imp_borel_cond μseq μ ⟨ hopcond , hclcond ⟩ ,
end

lemma portmanteau_closed_imp_borel
  (μseq : ℕ → @measure_theory.measure α (borel α))
  (μseq_fin : ∀ (n : ℕ) , @probability_measure α (borel(α)) (μseq(n)))
  (μ : @measure_theory.measure α (borel α)) (μ_fin : @probability_measure α (borel(α)) μ) :
    portmanteau_closed μseq μ → portmanteau_borel μseq μ :=
begin
  intros hclcond ,
  have hopcond := portmanteau_closed_imp_open_cond μseq μseq_fin μ μ_fin hclcond ,
  exact portmanteau_open_closed_imp_borel_cond μseq μ ⟨ hopcond , hclcond ⟩ ,
end

end portmanteau_open_closed_implies_borel

end portmanteau


import for_mathlib.locally_closed

namespace topological_space

variables (α β : Type*) [topological_space α] [topological_space β] (f : α → β)

def closed_points : set α := { x : α | is_closed ({x} : set α) }

lemma mem_closed_points {x} : x ∈ closed_points α ↔ is_closed ({x} : set α) := iff.rfl

def is_jacobson : Prop :=
∀ Z, is_closed Z → closure (Z ∩ closed_points α) = Z

variables {α β f}

lemma is_jacobson_iff_locally_closed :
  is_jacobson α ↔ ∀ Z : set α, Z.nonempty → is_locally_closed Z → (Z ∩ closed_points α).nonempty :=
begin
  split,
  { simp_rw [is_locally_closed_iff_is_open_coboundary, coboundary, is_open_compl_iff,
      ← set.ne_empty_iff_nonempty],
    intros H Z hZ hZ' e,
    have : Z ⊆ closure Z \ Z,
    { refine subset_closure.trans _,
      nth_rewrite 0 ← H (closure Z) is_closed_closure,
      rw [hZ'.closure_subset_iff, set.subset_diff, set.disjoint_iff, set.inter_assoc,
        set.inter_comm _ Z, e],
      exact ⟨set.inter_subset_left _ _, set.inter_subset_right _ _⟩ },
    rw [set.subset_diff, disjoint_self, set.bot_eq_empty] at this,
    exact hZ this.2 },
  { intros H Z hZ,
    refine subset_antisymm (hZ.closure_subset_iff.mpr $ set.inter_subset_left _ _) _,
    rw [← set.disjoint_compl_left_iff_subset, set.disjoint_iff_inter_eq_empty,
      ← set.not_nonempty_iff_eq_empty],
    intro H',
    have := H _ H' (is_closed_closure.is_open_compl.is_locally_closed.inter hZ.is_locally_closed),
    rw [← set.ne_empty_iff_nonempty, ne.def, set.inter_assoc,
      ← set.disjoint_iff_inter_eq_empty, set.disjoint_compl_left_iff_subset] at this,
    exact this subset_closure }
end

alias is_jacobson_iff_locally_closed ↔ is_jacobson.nonempty_inter_closed_points _

lemma is_jacobson.is_closed_of_is_locally_closed (hα : is_jacobson α) {x : α}
  (hx : is_locally_closed ({x} : set α)) : is_closed ({x} : set α) :=
begin
  obtain ⟨_, ⟨y, rfl : y = x, rfl⟩, hy'⟩ := hα.nonempty_inter_closed_points _
    (set.singleton_nonempty x) hx,
  exact hy'
end

lemma preimage_closed_points_subset (hf : embedding f) :
  f ⁻¹' closed_points β ⊆ closed_points α :=
begin
  intros x hx,
  rw mem_closed_points,
  convert continuous_iff_is_closed.mp hf.continuous _ hx,
  rw [← set.image_singleton, set.preimage_image_eq _ hf.inj]
end

lemma closed_embedding.preimage_closed_points (hf : closed_embedding f) :
  f ⁻¹' closed_points β = closed_points α :=
begin
  ext x, simp [mem_closed_points, ← set.image_singleton, hf.closed_iff_image_closed],
end

lemma open_embedding.preimage_closed_points (hf : open_embedding f) (hβ : is_jacobson β) :
  f ⁻¹' closed_points β = closed_points α :=
begin
  apply subset_antisymm (preimage_closed_points_subset hf.to_embedding),
  intros x hx,
  apply hβ.is_closed_of_is_locally_closed,
  rw ← set.image_singleton,
  exact (hx.is_locally_closed.image hf.to_inducing hf.open_range.is_locally_closed)
end

lemma is_jacobson.of_open_embedding (hα : is_jacobson β)
  (hf : open_embedding f) : is_jacobson α :=
begin
  rw is_jacobson_iff_locally_closed,
  rw ← hf.preimage_closed_points hα,
  rw is_jacobson_iff_locally_closed at hα,
  intros Z hZ hZ',
  obtain ⟨_, ⟨x, hx, rfl⟩, hx'⟩ := hα _ (hZ.image f) (hZ'.image hf.to_inducing
    hf.open_range.is_locally_closed),
  exact ⟨_, hx, hx'⟩
end

lemma is_jacobson.of_closed_embedding (hα : is_jacobson β)
  (hf : closed_embedding f) : is_jacobson α :=
begin
  rw is_jacobson_iff_locally_closed at hα ⊢,
  rw ← hf.preimage_closed_points,
  intros Z hZ hZ',
  obtain ⟨_, ⟨x, hx, rfl⟩, hx'⟩ := hα _ (hZ.image f) (hZ'.image hf.to_inducing
    hf.closed_range.is_locally_closed),
  exact ⟨_, hx, hx'⟩
end

lemma is_jacobson.discrete_of_finite [finite α] (hα : is_jacobson α) : discrete_topology α :=
begin
  suffices : closed_points α = set.univ,
  { rw ← forall_open_iff_discrete,
    intro s,
    rw [← is_closed_compl_iff, ← set.bUnion_of_singleton sᶜ],
    refine is_closed_bUnion (set.to_finite _) (λ x hx, _),
    rw [← mem_closed_points, this],
    trivial },
  rw [← set.univ_subset_iff, ← hα _ is_closed_univ, set.univ_inter, closure_subset_iff_is_closed,
    ← set.bUnion_of_singleton (closed_points α)],
  exact is_closed_bUnion (set.to_finite _) (λ _, id),
end

lemma {u} is_jacobson_iff_of_supr_eq_top {α : Type u} [topological_space α]
  {ι : Type u} {U : ι → opens α} (hU : supr U = ⊤) :
  is_jacobson α ↔ ∀ i, is_jacobson (U i) :=
begin
  refine ⟨λ h i, h.of_open_embedding (U i).2.open_embedding_subtype_coe, λ H, _⟩,
  rw is_jacobson_iff_locally_closed,
  intros Z hZ hZ',
  have : (⋃ i, (U i : set α)) = set.univ, { rw ← opens.coe_supr, injection hU },
  have : (⋃ i, Z ∩ U i) = Z, { rw [← set.inter_Union, this, set.inter_univ] },
  rw [← this, set.nonempty_Union] at hZ,
  obtain ⟨i, x, hx, hx'⟩ := hZ,
  obtain ⟨y, hy, hy'⟩ := (is_jacobson_iff_locally_closed.mp $ H i) (coe ⁻¹' Z) ⟨⟨x, hx'⟩, hx⟩
    (hZ'.preimage continuous_subtype_coe),
  refine ⟨y, hy, (is_closed_iff_coe_preimage_of_supr_eq_top hU _).mpr $ λ j, _⟩,
  by_cases (y : α) ∈ U j,
  { convert_to is_closed {(⟨y, h⟩ : U j)}, { ext z, exact @subtype.coe_inj _ _ z ⟨y, h⟩ },
    apply (H j).is_closed_of_is_locally_closed,
    convert (hy'.is_locally_closed.image embedding_subtype_coe.to_inducing
      (U i).2.open_embedding_subtype_coe.open_range.is_locally_closed).preimage
      continuous_subtype_coe,
    rw set.image_singleton, ext z, exact (@subtype.coe_inj _ _ z ⟨y, h⟩).symm },
  { convert is_closed_empty, rw set.eq_empty_iff_forall_not_mem, rintros z (hz : ↑z = ↑y),
    rw ← hz at h, exact h z.2 }
end

end topological_space


import data.finset

/-! This file implements terms of a pure type system -/

@[derive decidable_eq]
inductive PTSSort : Type | star | box
open PTSSort

instance ptssort_has_repr : has_repr PTSSort :=
  { repr := λ s, match s with star := "*" | box := "□" end }

inductive Exp : Type
| free : string → Exp
| bound : nat → Exp
| sort : PTSSort → Exp
| app : Exp → Exp → Exp
| lam : string → Exp → Exp → Exp
| pi : string → Exp → Exp → Exp

/-- A pretty printing of formulae. It doesn't try to interpolate
  de-bruijn variables, which means that (Π x, 0) is the identity
  function and (Π x, x) is the constant function for the free variable x. -/
def exp_repr : Exp → string
| (Exp.free x) := x
| (Exp.bound n) := repr n
| (Exp.sort s) := repr s
| (Exp.app a b) := exp_repr a ++ " (" ++ exp_repr b ++ ")"
| (Exp.lam x a b) := "λ(" ++ x ++ " : " ++ exp_repr a ++ ") → " ++ exp_repr b
| (Exp.pi x a b) := "Π(" ++ x ++ " : " ++ exp_repr a ++ ") → " ++ exp_repr b

instance exp_has_repr : has_repr Exp :=
  { repr := exp_repr }

 -- apply_instance fails below, so we restate the lemma here.
def decidable_and {p q : Prop} [decidable p] [decidable q] : decidable (p ∧ q) :=
  infer_instance

instance exp_decidable_eq : decidable_eq Exp :=
λ a b, begin
  induction a generalizing b,
    cases b, repeat { simp, from decidable.false },
      simp, from string.has_decidable_eq a b,
    cases b, repeat { simp, from decidable.false },
      simp, from nat.decidable_eq a b,
    cases b, repeat { simp, from decidable.false },
      simp, let d : decidable_eq PTSSort := infer_instance,
      from d a b,
    cases b, repeat { simp, from decidable.false },
      simp, letI h1 := a_ih_a b_a, letI h2 := a_ih_a_1 b_a_1,
      from @decidable_and _ _ h1 h2,
    repeat { cases b, repeat { simp, from decidable.false },
      simp, letI h1 := a_ih_a b_a_1, letI h2 := a_ih_a_1 b_a_2,
      letI h3 := string.has_decidable_eq a_a b_a,
      apply_instance, }
end

@[simp] def abstract_help (x : string) : Exp → nat → Exp
| e@(Exp.free y) n := if x = y then Exp.bound n else e
| e@(Exp.bound _) n := e
| e@(Exp.sort _) n := e
| (Exp.app f e) n := Exp.app (abstract_help f n) (abstract_help e n)
| (Exp.lam y t e) n := Exp.lam y (abstract_help t n) (abstract_help e (n+1))
| (Exp.pi y t e) n := Exp.pi y (abstract_help t n) (abstract_help e (n+1))

/-- Turn the free variable x into a fresh de-bruijn index.
    Given an expression e, we can turn it into a function with:
    Exp.lam x _ (abstract x e) -/
def abstract (x : string) (e : Exp) : Exp :=
  abstract_help x e 0

@[simp] def instantiate_help (x : Exp) : Exp → nat → Exp
| e@(Exp.free _) n := e
| e@(Exp.bound b) n := if b = n then x else e
| e@(Exp.sort _) n := e
| (Exp.app f e) n := Exp.app (instantiate_help f n) (instantiate_help e n)
| (Exp.lam y t e) n := Exp.lam y (instantiate_help t n) (instantiate_help e (n + 1))
| (Exp.pi y t e) n := Exp.pi y (instantiate_help t n) (instantiate_help e (n + 1))

/-- Instantiate the top-most de-bruijn index with x.
    Given a expression (Exp.lam x _ e), we can use A for x
    by instantiate A e. -/
def instantiate (x : Exp) (e : Exp) : Exp :=
  instantiate_help x e 0

/-- Substitute the free variable x by r in e. -/
def substitute (x : string) (r : Exp) (e : Exp) : Exp :=
  instantiate r (abstract x e)

/-- The free variables in an expression -/
@[simp] def free_vars : Π (e : Exp), finset string
| (Exp.free x) := finset.singleton x
| (Exp.app a b) := free_vars a ∪ free_vars b
| (Exp.lam _ a b) := free_vars a ∪ free_vars b
| (Exp.pi _ a b) := free_vars a ∪ free_vars b
| (Exp.bound _) := ∅
| (Exp.sort _) := ∅

/-- The bound variables -/
@[simp] def bound_vars : Π (e : Exp), finset string
| (Exp.app a b) := free_vars a ∪ free_vars b
| (Exp.lam x a b) := insert x (free_vars a ∪ free_vars b)
| (Exp.pi x a b) := insert x (free_vars a ∪ free_vars b)
| _ := ∅


/-
Copyright (c) 2021 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import analysis.normed_space.basic
import analysis.specific_limits
import topology.sequences

/-!
# Normed groups homomorphisms

This file gathers definitions and elementary constructions about bounded group homomorphisms
between normed (abelian) groups (abbreviated to "normed group homs").

The main lemmas relate the boundedness condition to continuity and Lipschitzness.

The main construction is to endow the type of normed group homs between two given normed groups
with a group structure and a norm, giving rise to a normed group structure. We provide several
simple constructions for normed group homs, like kernel, range and equalizer.

Some easy other constructions are related to subgroups of normed groups.

Since a lot of elementary properties don't require `∥x∥ = 0 → x = 0` we start setting up the
theory of `semi_normed_group_hom` and we specialize to `normed_group_hom` when needed.
-/

noncomputable theory
open_locale nnreal big_operators

/-- A morphism of seminormed abelian groups is a bounded group homomorphism. -/
structure normed_group_hom (V W : Type*) [semi_normed_group V] [semi_normed_group W] :=
(to_fun : V → W)
(map_add' : ∀ v₁ v₂, to_fun (v₁ + v₂) = to_fun v₁ + to_fun v₂)
(bound' : ∃ C, ∀ v, ∥to_fun v∥ ≤ C * ∥v∥)

namespace add_monoid_hom

variables {V W : Type*} [semi_normed_group V] [semi_normed_group W] {f g : normed_group_hom V W}

/-- Associate to a group homomorphism a bounded group homomorphism under a norm control condition.

See `add_monoid_hom.mk_normed_group_hom'` for a version that uses `ℝ≥0` for the bound. -/
def mk_normed_group_hom (f : V →+ W)
  (C : ℝ) (h : ∀ v, ∥f v∥ ≤ C * ∥v∥) : normed_group_hom V W :=
{ bound' := ⟨C, h⟩, ..f }

/-- Associate to a group homomorphism a bounded group homomorphism under a norm control condition.

See `add_monoid_hom.mk_normed_group_hom` for a version that uses `ℝ` for the bound. -/
def mk_normed_group_hom' (f : V →+ W) (C : ℝ≥0) (hC : ∀ x, nnnorm (f x) ≤ C * nnnorm x) :
  normed_group_hom V W :=
{ bound' := ⟨C, hC⟩ .. f}

end add_monoid_hom

lemma exists_pos_bound_of_bound {V W : Type*} [semi_normed_group V] [semi_normed_group W]
  {f : V → W} (M : ℝ) (h : ∀x, ∥f x∥ ≤ M * ∥x∥) :
  ∃ N, 0 < N ∧ ∀x, ∥f x∥ ≤ N * ∥x∥ :=
⟨max M 1, lt_of_lt_of_le zero_lt_one (le_max_right _ _), λx, calc
  ∥f x∥ ≤ M * ∥x∥ : h x
  ... ≤ max M 1 * ∥x∥ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _) ⟩

namespace normed_group_hom

variables {V V₁ V₂ V₃ : Type*}
variables [semi_normed_group V] [semi_normed_group V₁] [semi_normed_group V₂] [semi_normed_group V₃]
variables {f g : normed_group_hom V₁ V₂}

instance : has_coe_to_fun (normed_group_hom V₁ V₂) (λ _, V₁ → V₂) := ⟨normed_group_hom.to_fun⟩

initialize_simps_projections normed_group_hom (to_fun → apply)

lemma coe_inj (H : (f : V₁ → V₂) = g) : f = g :=
by cases f; cases g; congr'; exact funext H

lemma coe_injective : @function.injective (normed_group_hom V₁ V₂) (V₁ → V₂) coe_fn :=
by apply coe_inj

lemma coe_inj_iff : f = g ↔ (f : V₁ → V₂) = g := ⟨congr_arg _, coe_inj⟩

@[ext] lemma ext (H : ∀ x, f x = g x) : f = g := coe_inj $ funext H

lemma ext_iff : f = g ↔ ∀ x, f x = g x := ⟨by rintro rfl x; refl, ext⟩

variables (f g)

@[simp] lemma to_fun_eq_coe : f.to_fun = f := rfl

@[simp] lemma coe_mk (f) (h₁) (h₂) (h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ : normed_group_hom V₁ V₂) = f := rfl

@[simp] lemma coe_mk_normed_group_hom (f : V₁ →+ V₂) (C) (hC) :
  ⇑(f.mk_normed_group_hom C hC) = f := rfl

@[simp] lemma coe_mk_normed_group_hom' (f : V₁ →+ V₂) (C) (hC) :
  ⇑(f.mk_normed_group_hom' C hC) = f := rfl

/-- The group homomorphism underlying a bounded group homomorphism. -/
def to_add_monoid_hom (f : normed_group_hom V₁ V₂) : V₁ →+ V₂ :=
add_monoid_hom.mk' f f.map_add'

@[simp] lemma coe_to_add_monoid_hom : ⇑f.to_add_monoid_hom = f := rfl

lemma to_add_monoid_hom_injective :
  function.injective (@normed_group_hom.to_add_monoid_hom V₁ V₂ _ _) :=
λ f g h, coe_inj $ show ⇑f.to_add_monoid_hom = g, by { rw h, refl }

@[simp]

@[simp] lemma map_zero : f 0 = 0 := f.to_add_monoid_hom.map_zero

@[simp] lemma map_add (x y) : f (x + y) = f x + f y := f.to_add_monoid_hom.map_add _ _

@[simp] lemma map_sum {ι : Type*} (v : ι → V₁) (s : finset ι) :
  f (∑ i in s, v i) = ∑ i in s, f (v i) :=
f.to_add_monoid_hom.map_sum _ _

@[simp] lemma map_sub (x y) : f (x - y) = f x - f y := f.to_add_monoid_hom.map_sub _ _

@[simp] lemma map_neg (x) : f (-x) = -(f x) := f.to_add_monoid_hom.map_neg _

lemma bound : ∃ C, 0 < C ∧ ∀ x, ∥f x∥ ≤ C * ∥x∥ :=
let ⟨C, hC⟩ := f.bound' in exists_pos_bound_of_bound _ hC

theorem antilipschitz_of_norm_ge {K : ℝ≥0} (h : ∀ x, ∥x∥ ≤ K * ∥f x∥) :
  antilipschitz_with K f :=
antilipschitz_with.of_le_mul_dist $
λ x y, by simpa only [dist_eq_norm, f.map_sub] using h (x - y)

/-- A normed group hom is surjective on the subgroup `K` with constant `C` if every element
`x` of `K` has a preimage whose norm is bounded above by `C*∥x∥`. This is a more
abstract version of `f` having a right inverse defined on `K` with operator norm
at most `C`. -/
def surjective_on_with (f : normed_group_hom V₁ V₂) (K : add_subgroup V₂) (C : ℝ) : Prop :=
  ∀ h ∈ K, ∃ g, f g = h ∧ ∥g∥ ≤ C*∥h∥

lemma surjective_on_with.mono {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C C' : ℝ}
  (h : f.surjective_on_with K C) (H : C ≤ C') : f.surjective_on_with K C' :=
begin
  intros k k_in,
  rcases h k k_in with ⟨g, rfl, hg⟩,
  use [g, rfl],
  by_cases Hg : ∥f g∥ = 0,
  { simpa [Hg] using hg },
  { exact hg.trans ((mul_le_mul_right $ (ne.symm Hg).le_iff_lt.mp (norm_nonneg _)).mpr H) }
end

lemma surjective_on_with.exists_pos {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ}
  (h : f.surjective_on_with K C) : ∃ C' > 0, f.surjective_on_with K C' :=
begin
  refine ⟨|C| + 1, _, _⟩,
  { linarith [abs_nonneg C] },
  { apply h.mono,
    linarith [le_abs_self C] }
end

lemma surjective_on_with.surj_on {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ}
  (h : f.surjective_on_with K C) : set.surj_on f set.univ K :=
λ x hx, (h x hx).imp $ λ a ⟨ha, _⟩, ⟨set.mem_univ _, ha⟩

/-! ### The operator norm -/

/-- The operator norm of a seminormed group homomorphism is the inf of all its bounds. -/
def op_norm (f : normed_group_hom V₁ V₂) := Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥}
instance has_op_norm : has_norm (normed_group_hom V₁ V₂) := ⟨op_norm⟩

lemma norm_def : ∥f∥ = Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} := rfl

-- So that invocations of `le_cInf` make sense: we show that the set of
-- bounds is nonempty and bounded below.
lemma bounds_nonempty {f : normed_group_hom V₁ V₂} :
  ∃ c, c ∈ { c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥ } :=
let ⟨M, hMp, hMb⟩ := f.bound in ⟨M, le_of_lt hMp, hMb⟩

lemma bounds_bdd_below {f : normed_group_hom V₁ V₂} :
  bdd_below {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} :=
⟨0, λ _ ⟨hn, _⟩, hn⟩

lemma op_norm_nonneg : 0 ≤ ∥f∥ :=
le_cInf bounds_nonempty (λ _ ⟨hx, _⟩, hx)

/-- The fundamental property of the operator norm: `∥f x∥ ≤ ∥f∥ * ∥x∥`. -/
theorem le_op_norm (x : V₁) : ∥f x∥ ≤ ∥f∥ * ∥x∥ :=
begin
  obtain ⟨C, Cpos, hC⟩ := f.bound,
  replace hC := hC x,
  by_cases h : ∥x∥ = 0,
  { rwa [h, mul_zero] at ⊢ hC },
  have hlt : 0 < ∥x∥ := lt_of_le_of_ne (norm_nonneg x) (ne.symm h),
  exact (div_le_iff hlt).mp (le_cInf bounds_nonempty (λ c ⟨_, hc⟩,
    (div_le_iff hlt).mpr $ by { apply hc })),
end

theorem le_op_norm_of_le {c : ℝ} {x} (h : ∥x∥ ≤ c) : ∥f x∥ ≤ ∥f∥ * c :=
le_trans (f.le_op_norm x) (mul_le_mul_of_nonneg_left h f.op_norm_nonneg)

theorem le_of_op_norm_le {c : ℝ} (h : ∥f∥ ≤ c) (x : V₁) : ∥f x∥ ≤ c * ∥x∥ :=
(f.le_op_norm x).trans (mul_le_mul_of_nonneg_right h (norm_nonneg x))

/-- continuous linear maps are Lipschitz continuous. -/
theorem lipschitz : lipschitz_with ⟨∥f∥, op_norm_nonneg f⟩ f :=
lipschitz_with.of_dist_le_mul $ λ x y,
  by { rw [dist_eq_norm, dist_eq_norm, ←map_sub], apply le_op_norm }

protected lemma uniform_continuous (f : normed_group_hom V₁ V₂) :
  uniform_continuous f := f.lipschitz.uniform_continuous

@[continuity]
protected lemma continuous (f : normed_group_hom V₁ V₂) : continuous f :=
f.uniform_continuous.continuous

lemma ratio_le_op_norm (x : V₁) : ∥f x∥ / ∥x∥ ≤ ∥f∥ :=
div_le_of_nonneg_of_le_mul (norm_nonneg _) f.op_norm_nonneg (le_op_norm _ _)

/-- If one controls the norm of every `f x`, then one controls the norm of `f`. -/
lemma op_norm_le_bound {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ x, ∥f x∥ ≤ M * ∥x∥) :
  ∥f∥ ≤ M :=
cInf_le bounds_bdd_below ⟨hMp, hM⟩

lemma op_norm_eq_of_bounds {M : ℝ} (M_nonneg : 0 ≤ M)
  (h_above : ∀ x, ∥f x∥ ≤ M*∥x∥) (h_below : ∀ N ≥ 0, (∀ x, ∥f x∥ ≤ N*∥x∥) → M ≤ N) :
  ∥f∥ = M :=
le_antisymm (f.op_norm_le_bound M_nonneg h_above)
  ((le_cInf_iff normed_group_hom.bounds_bdd_below ⟨M, M_nonneg, h_above⟩).mpr $
   λ N ⟨N_nonneg, hN⟩, h_below N N_nonneg hN)

theorem op_norm_le_of_lipschitz {f : normed_group_hom V₁ V₂} {K : ℝ≥0} (hf : lipschitz_with K f) :
  ∥f∥ ≤ K :=
f.op_norm_le_bound K.2 $ λ x, by simpa only [dist_zero_right, f.map_zero] using hf.dist_le_mul x 0

/-- If a bounded group homomorphism map is constructed from a group homomorphism via the constructor
`mk_normed_group_hom`, then its norm is bounded by the bound given to the constructor if it is
nonnegative. -/
lemma mk_normed_group_hom_norm_le (f : V₁ →+ V₂) {C : ℝ} (hC : 0 ≤ C) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) :
  ∥f.mk_normed_group_hom C h∥ ≤ C :=
op_norm_le_bound _ hC h

/-- If a bounded group homomorphism map is constructed from a group homomorphism
via the constructor `mk_normed_group_hom`, then its norm is bounded by the bound
given to the constructor or zero if this bound is negative. -/
lemma mk_normed_group_hom_norm_le' (f : V₁ →+ V₂) {C : ℝ} (h : ∀x, ∥f x∥ ≤ C * ∥x∥) :
  ∥f.mk_normed_group_hom C h∥ ≤ max C 0 :=
op_norm_le_bound _ (le_max_right _ _) $ λ x, (h x).trans $
  mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg x)

alias mk_normed_group_hom_norm_le ← add_monoid_hom.mk_normed_group_hom_norm_le
alias mk_normed_group_hom_norm_le' ← add_monoid_hom.mk_normed_group_hom_norm_le'

/-! ### Addition of normed group homs -/

/-- Addition of normed group homs. -/
instance : has_add (normed_group_hom V₁ V₂) :=
⟨λ f g, (f.to_add_monoid_hom + g.to_add_monoid_hom).mk_normed_group_hom (∥f∥ + ∥g∥) $ λ v, calc
  ∥f v + g v∥
      ≤ ∥f v∥ + ∥g v∥ : norm_add_le _ _
  ... ≤ ∥f∥ * ∥v∥ + ∥g∥ * ∥v∥ : add_le_add (le_op_norm f v) (le_op_norm g v)
  ... = (∥f∥ + ∥g∥) * ∥v∥ : by rw add_mul⟩

/-- The operator norm satisfies the triangle inequality. -/
theorem op_norm_add_le : ∥f + g∥ ≤ ∥f∥ + ∥g∥ :=
mk_normed_group_hom_norm_le _ (add_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _

/--
Terms containing `@has_add.add (has_coe_to_fun.F ...) pi.has_add`
seem to cause leanchecker to [crash due to an out-of-memory
condition](https://github.com/leanprover-community/lean/issues/543).
As a workaround, we add a type annotation: `(f + g : V₁ → V₂)`
-/
library_note "addition on function coercions"

-- see Note [addition on function coercions]
@[simp] lemma coe_add (f g : normed_group_hom V₁ V₂) : ⇑(f + g) = (f + g : V₁ → V₂) := rfl
@[simp] lemma add_apply (f g : normed_group_hom V₁ V₂) (v : V₁) :
  (f + g : normed_group_hom V₁ V₂) v = f v + g v := rfl

/-! ### The zero normed group hom -/

instance : has_zero (normed_group_hom V₁ V₂) :=
⟨(0 : V₁ →+ V₂).mk_normed_group_hom 0 (by simp)⟩

instance : inhabited (normed_group_hom V₁ V₂) := ⟨0⟩

/-- The norm of the `0` operator is `0`. -/
theorem op_norm_zero : ∥(0 : normed_group_hom V₁ V₂)∥ = 0 :=
le_antisymm (cInf_le bounds_bdd_below
    ⟨ge_of_eq rfl, λ _, le_of_eq (by { rw [zero_mul], exact norm_zero })⟩)
    (op_norm_nonneg _)

/-- For normed groups, an operator is zero iff its norm vanishes. -/
theorem op_norm_zero_iff {V₁ V₂ : Type*} [normed_group V₁] [normed_group V₂]
  {f : normed_group_hom V₁ V₂} : ∥f∥ = 0 ↔ f = 0 :=
iff.intro
  (λ hn, ext (λ x, norm_le_zero_iff.1
    (calc _ ≤ ∥f∥ * ∥x∥ : le_op_norm _ _
     ...     = _ : by rw [hn, zero_mul])))
  (λ hf, by rw [hf, op_norm_zero] )

-- see Note [addition on function coercions]
@[simp] lemma coe_zero : ⇑(0 : normed_group_hom V₁ V₂) = (0 : V₁ → V₂) := rfl
@[simp] lemma zero_apply (v : V₁) : (0 : normed_group_hom V₁ V₂) v = 0 := rfl

variables {f g}

/-! ### The identity normed group hom -/

variable (V)

/-- The identity as a continuous normed group hom. -/
@[simps]
def id : normed_group_hom V V :=
(add_monoid_hom.id V).mk_normed_group_hom 1 (by simp [le_refl])

/-- The norm of the identity is at most `1`. It is in fact `1`, except when the norm of every
element vanishes, where it is `0`. (Since we are working with seminorms this can happen even if the
space is non-trivial.) It means that one can not do better than an inequality in general. -/
lemma norm_id_le : ∥(id V : normed_group_hom V V)∥ ≤ 1 :=
op_norm_le_bound _ zero_le_one (λx, by simp)

/-- If there is an element with norm different from `0`, then the norm of the identity equals `1`.
(Since we are working with seminorms supposing that the space is non-trivial is not enough.) -/
lemma norm_id_of_nontrivial_seminorm (h : ∃ (x : V), ∥x∥ ≠ 0 ) :
  ∥(id V)∥ = 1 :=
le_antisymm (norm_id_le V) $ let ⟨x, hx⟩ := h in
have _ := (id V).ratio_le_op_norm x,
by rwa [id_apply, div_self hx] at this

/-- If a normed space is non-trivial, then the norm of the identity equals `1`. -/
lemma norm_id {V : Type*} [normed_group V] [nontrivial V] : ∥(id V)∥ = 1 :=
begin
  refine norm_id_of_nontrivial_seminorm V _,
  obtain ⟨x, hx⟩ := exists_ne (0 : V),
  exact ⟨x, ne_of_gt (norm_pos_iff.2 hx)⟩,
end

lemma coe_id : ((normed_group_hom.id V) : V → V) = (_root_.id : V → V) := rfl

/-! ### The negation of a normed group hom -/

/-- Opposite of a normed group hom. -/
instance : has_neg (normed_group_hom V₁ V₂) :=
⟨λ f, (-f.to_add_monoid_hom).mk_normed_group_hom (∥f∥) (λ v, by simp [le_op_norm f v])⟩

-- see Note [addition on function coercions]
@[simp] lemma coe_neg (f : normed_group_hom V₁ V₂) : ⇑(-f) = (-f : V₁ → V₂) := rfl
@[simp] lemma neg_apply (f : normed_group_hom V₁ V₂) (v : V₁) :
  (-f : normed_group_hom V₁ V₂) v = - (f v) := rfl

lemma op_norm_neg (f : normed_group_hom V₁ V₂) : ∥-f∥ = ∥f∥ :=
by simp only [norm_def, coe_neg, norm_neg, pi.neg_apply]

/-! ### Subtraction of normed group homs -/

/-- Subtraction of normed group homs. -/
instance : has_sub (normed_group_hom V₁ V₂) :=
⟨λ f g,
{ bound' :=
  begin
    simp only [add_monoid_hom.sub_apply, add_monoid_hom.to_fun_eq_coe, sub_eq_add_neg],
    exact (f + -g).bound'
  end,
  .. (f.to_add_monoid_hom - g.to_add_monoid_hom) }⟩

-- see Note [addition on function coercions]
@[simp] lemma coe_sub (f g : normed_group_hom V₁ V₂) : ⇑(f - g) = (f - g : V₁ → V₂) := rfl
@[simp] lemma sub_apply (f g : normed_group_hom V₁ V₂) (v : V₁) :
  (f - g : normed_group_hom V₁ V₂) v = f v - g v := rfl

/-! ### Normed group structure on normed group homs -/

/-- Homs between two given normed groups form a commutative additive group. -/
instance : add_comm_group (normed_group_hom V₁ V₂) :=
coe_injective.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)

/-- Normed group homomorphisms themselves form a seminormed group with respect to
    the operator norm. -/
instance to_semi_normed_group : semi_normed_group (normed_group_hom V₁ V₂) :=
semi_normed_group.of_core _ ⟨op_norm_zero, op_norm_add_le, op_norm_neg⟩

/-- Normed group homomorphisms themselves form a normed group with respect to
    the operator norm. -/
instance to_normed_group {V₁ V₂ : Type*} [normed_group V₁] [normed_group V₂] :
  normed_group (normed_group_hom V₁ V₂) :=
normed_group.of_core _ ⟨λ f, op_norm_zero_iff, op_norm_add_le, op_norm_neg⟩

/-- Coercion of a `normed_group_hom` is an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn` -/
@[simps]
def coe_fn_add_hom : normed_group_hom V₁ V₂ →+ (V₁ → V₂) :=
{ to_fun := coe_fn, map_zero' := coe_zero, map_add' := coe_add}

@[simp] lemma coe_sum {ι : Type*} (s : finset ι) (f : ι → normed_group_hom V₁ V₂) :
  ⇑(∑ i in s, f i) = ∑ i in s, (f i) :=
(coe_fn_add_hom : _ →+ (V₁ → V₂)).map_sum f s

lemma sum_apply {ι : Type*} (s : finset ι) (f : ι → normed_group_hom V₁ V₂) (v : V₁) :
  (∑ i in s, f i) v = ∑ i in s, (f i v) :=
by simp only [coe_sum, finset.sum_apply]

/-! ### Composition of normed group homs -/

/-- The composition of continuous normed group homs. -/
@[simps]
protected def comp (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) :
  normed_group_hom V₁ V₃ :=
(g.to_add_monoid_hom.comp f.to_add_monoid_hom).mk_normed_group_hom (∥g∥ * ∥f∥) $ λ v, calc
∥g (f v)∥ ≤ ∥g∥ * ∥f v∥ : le_op_norm _ _
... ≤ ∥g∥ * (∥f∥ * ∥v∥) : mul_le_mul_of_nonneg_left (le_op_norm _ _) (op_norm_nonneg _)
... = ∥g∥ * ∥f∥ * ∥v∥   : by rw mul_assoc

lemma norm_comp_le (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) :
  ∥g.comp f∥ ≤ ∥g∥ * ∥f∥ :=
mk_normed_group_hom_norm_le _ (mul_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _

lemma norm_comp_le_of_le {g : normed_group_hom V₂ V₃} {C₁ C₂ : ℝ} (hg : ∥g∥ ≤ C₂) (hf : ∥f∥ ≤ C₁) :
  ∥g.comp f∥ ≤ C₂ * C₁ :=
le_trans (norm_comp_le g f) $ mul_le_mul hg hf (norm_nonneg _) (le_trans (norm_nonneg _) hg)

lemma norm_comp_le_of_le' {g : normed_group_hom V₂ V₃} (C₁ C₂ C₃ : ℝ) (h : C₃ = C₂ * C₁)
  (hg : ∥g∥ ≤ C₂) (hf : ∥f∥ ≤ C₁) : ∥g.comp f∥ ≤ C₃ :=
by { rw h, exact norm_comp_le_of_le hg hf }

/-- Composition of normed groups hom as an additive group morphism. -/
def comp_hom : (normed_group_hom V₂ V₃) →+ (normed_group_hom V₁ V₂) →+ (normed_group_hom V₁ V₃) :=
add_monoid_hom.mk' (λ g, add_monoid_hom.mk' (λ f, g.comp f)
  (by { intros, ext, exact g.map_add _ _ }))
  (by { intros, ext, simp only [comp_apply, pi.add_apply, function.comp_app,
                                add_monoid_hom.add_apply, add_monoid_hom.mk'_apply, coe_add] })

@[simp] lemma comp_zero (f : normed_group_hom V₂ V₃) : f.comp (0 : normed_group_hom V₁ V₂) = 0 :=
by { ext, exact f.map_zero }

@[simp] lemma zero_comp (f : normed_group_hom V₁ V₂) : (0 : normed_group_hom V₂ V₃).comp f = 0 :=
by { ext, refl }

lemma comp_assoc {V₄: Type* } [semi_normed_group V₄] (h : normed_group_hom V₃ V₄)
  (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) :
  (h.comp g).comp f = h.comp (g.comp f) :=
by { ext, refl }

lemma coe_comp (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃) :
  (g.comp f : V₁ → V₃) = (g : V₂ → V₃) ∘ (f : V₁ → V₂) := rfl

end normed_group_hom

namespace normed_group_hom

variables {V W V₁ V₂ V₃ : Type*}
variables [semi_normed_group V] [semi_normed_group W] [semi_normed_group V₁] [semi_normed_group V₂]
[semi_normed_group V₃]

/-- The inclusion of an `add_subgroup`, as bounded group homomorphism. -/
@[simps] def incl (s : add_subgroup V) : normed_group_hom s V :=
{ to_fun := (coe : s → V),
  map_add' := λ v w, add_subgroup.coe_add _ _ _,
  bound' := ⟨1, λ v, by { rw [one_mul], refl }⟩ }

lemma norm_incl {V' : add_subgroup V} (x : V') : ∥incl _ x∥ = ∥x∥ :=
rfl

/-!### Kernel -/
section kernels
variables (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃)

/-- The kernel of a bounded group homomorphism. Naturally endowed with a
`semi_normed_group` instance. -/
def ker : add_subgroup V₁ := f.to_add_monoid_hom.ker

lemma mem_ker (v : V₁) : v ∈ f.ker ↔ f v = 0 :=
by { erw f.to_add_monoid_hom.mem_ker, refl }

/-- Given a normed group hom `f : V₁ → V₂` satisfying `g.comp f = 0` for some `g : V₂ → V₃`,
    the corestriction of `f` to the kernel of `g`. -/
@[simps] def ker.lift (h : g.comp f = 0) :
  normed_group_hom V₁ g.ker :=
{ to_fun := λ v, ⟨f v, by { erw g.mem_ker, show (g.comp f) v = 0, rw h, refl }⟩,
  map_add' := λ v w, by { simp only [map_add], refl },
  bound' := f.bound' }

@[simp] lemma ker.incl_comp_lift (h : g.comp f = 0) :
  (incl g.ker).comp (ker.lift f g h) = f :=
by { ext, refl }

@[simp]
lemma ker_zero : (0 : normed_group_hom V₁ V₂).ker = ⊤ :=
by { ext, simp [mem_ker] }

lemma coe_ker : (f.ker : set V₁) = (f : V₁ → V₂) ⁻¹' {0} := rfl

lemma is_closed_ker {V₂ : Type*} [normed_group V₂] (f : normed_group_hom V₁ V₂) :
  is_closed (f.ker : set V₁) :=
f.coe_ker ▸ is_closed.preimage f.continuous (t1_space.t1 0)

end kernels

/-! ### Range -/
section range

variables (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃)

/-- The image of a bounded group homomorphism. Naturally endowed with a
`semi_normed_group` instance. -/
def range : add_subgroup V₂ := f.to_add_monoid_hom.range

lemma mem_range (v : V₂) : v ∈ f.range ↔ ∃ w, f w = v :=
by { rw [range, add_monoid_hom.mem_range], refl }

@[simp]
lemma mem_range_self (v : V₁) : f v ∈ f.range :=
⟨v, rfl⟩

lemma comp_range : (g.comp f).range = add_subgroup.map g.to_add_monoid_hom f.range :=
by { erw add_monoid_hom.map_range, refl }

lemma incl_range (s : add_subgroup V₁) : (incl s).range = s :=
by { ext x, exact ⟨λ ⟨y, hy⟩, by { rw ← hy; simp }, λ hx, ⟨⟨x, hx⟩, by simp⟩⟩ }

@[simp]
lemma range_comp_incl_top : (f.comp (incl (⊤ : add_subgroup V₁))).range = f.range :=
by simpa [comp_range, incl_range, ← add_monoid_hom.range_eq_map]

end range

variables {f : normed_group_hom V W}

/-- A `normed_group_hom` is *norm-nonincreasing* if `∥f v∥ ≤ ∥v∥` for all `v`. -/
def norm_noninc (f : normed_group_hom V W) : Prop :=
∀ v, ∥f v∥ ≤ ∥v∥

namespace norm_noninc

lemma norm_noninc_iff_norm_le_one : f.norm_noninc ↔ ∥f∥ ≤ 1 :=
begin
  refine ⟨λ h, _, λ h, λ v, _⟩,
  { refine op_norm_le_bound _ (zero_le_one) (λ v, _),
    simpa [one_mul] using h v },
  { simpa using le_of_op_norm_le f h v }
end

lemma zero : (0 : normed_group_hom V₁ V₂).norm_noninc :=
λ v, by simp

lemma id : (id V).norm_noninc :=
λ v, le_rfl

lemma comp {g : normed_group_hom V₂ V₃} {f : normed_group_hom V₁ V₂}
  (hg : g.norm_noninc) (hf : f.norm_noninc) :
  (g.comp f).norm_noninc :=
λ v, (hg (f v)).trans (hf v)

@[simp] lemma neg_iff {f : normed_group_hom V₁ V₂} : (-f).norm_noninc ↔ f.norm_noninc :=
⟨λ h x, by { simpa using h x }, λ h x, (norm_neg (f x)).le.trans (h x)⟩

end norm_noninc

section isometry

lemma isometry_iff_norm (f : normed_group_hom V W) :
  isometry f ↔ ∀ v, ∥f v∥ = ∥v∥ :=
add_monoid_hom.isometry_iff_norm f.to_add_monoid_hom

lemma isometry_of_norm (f : normed_group_hom V W) (hf : ∀ v, ∥f v∥ = ∥v∥) :
  isometry f :=
f.isometry_iff_norm.mpr hf

lemma norm_eq_of_isometry {f : normed_group_hom V W} (hf : isometry f) (v : V) :
  ∥f v∥ = ∥v∥ :=
f.isometry_iff_norm.mp hf v

lemma isometry_id : @isometry V V _ _ (id V) :=
isometry_id

lemma isometry_comp {g : normed_group_hom V₂ V₃} {f : normed_group_hom V₁ V₂}
  (hg : isometry g) (hf : isometry f) :
  isometry (g.comp f) :=
hg.comp hf

lemma norm_noninc_of_isometry (hf : isometry f) : f.norm_noninc :=
λ v, le_of_eq $ norm_eq_of_isometry hf v

end isometry

variables {W₁ W₂ W₃ : Type*} [semi_normed_group W₁] [semi_normed_group W₂] [semi_normed_group W₃]
variables (f) (g : normed_group_hom V W)
variables {f₁ g₁ : normed_group_hom V₁ W₁}
variables {f₂ g₂ : normed_group_hom V₂ W₂}
variables {f₃ g₃ : normed_group_hom V₃ W₃}

/-- The equalizer of two morphisms `f g : normed_group_hom V W`. -/
def equalizer := (f - g).ker

namespace equalizer

/-- The inclusion of `f.equalizer g` as a `normed_group_hom`. -/
def ι : normed_group_hom (f.equalizer g) V := incl _

lemma comp_ι_eq : f.comp (ι f g) = g.comp (ι f g) :=
by { ext, rw [comp_apply, comp_apply, ← sub_eq_zero, ← normed_group_hom.sub_apply], exact x.2 }

variables {f g}

/-- If `φ : normed_group_hom V₁ V` is such that `f.comp φ = g.comp φ`, the induced morphism
`normed_group_hom V₁ (f.equalizer g)`. -/
@[simps]
def lift (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) :
  normed_group_hom V₁ (f.equalizer g) :=
{ to_fun := λ v, ⟨φ v, show (f - g) (φ v) = 0,
    by rw [normed_group_hom.sub_apply, sub_eq_zero, ← comp_apply, h, comp_apply]⟩,
  map_add' := λ v₁ v₂, by { ext, simp only [map_add, add_subgroup.coe_add, subtype.coe_mk] },
  bound' := by { obtain ⟨C, C_pos, hC⟩ := φ.bound, exact ⟨C, hC⟩ } }

@[simp] lemma ι_comp_lift (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) :
  (ι _ _).comp (lift φ h) = φ :=
by { ext, refl }

/-- The lifting property of the equalizer as an equivalence. -/
@[simps]
def lift_equiv : {φ : normed_group_hom V₁ V // f.comp φ = g.comp φ} ≃
  normed_group_hom V₁ (f.equalizer g) :=
{ to_fun := λ φ, lift φ φ.prop,
  inv_fun := λ ψ, ⟨(ι f g).comp ψ, by { rw [← comp_assoc, ← comp_assoc, comp_ι_eq] }⟩,
  left_inv := λ φ, by simp,
  right_inv := λ ψ, by { ext, refl } }

/-- Given `φ : normed_group_hom V₁ V₂` and `ψ : normed_group_hom W₁ W₂` such that
`ψ.comp f₁ = f₂.comp φ` and `ψ.comp g₁ = g₂.comp φ`, the induced morphism
`normed_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂)`. -/
def map (φ : normed_group_hom V₁ V₂) (ψ : normed_group_hom W₁ W₂)
  (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) :
  normed_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂) :=
lift (φ.comp $ ι _ _) $
by { simp only [← comp_assoc, ← hf, ← hg], simp only [comp_assoc, comp_ι_eq] }

variables {φ : normed_group_hom V₁ V₂} {ψ : normed_group_hom W₁ W₂}
variables {φ' : normed_group_hom V₂ V₃} {ψ' : normed_group_hom W₂ W₃}

@[simp] lemma ι_comp_map (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) :
  (ι f₂ g₂).comp (map φ ψ hf hg) = φ.comp (ι _ _) :=
ι_comp_lift _ _

@[simp] lemma map_id : map (id V₁) (id W₁) rfl rfl = id (f₁.equalizer g₁) :=
by { ext, refl }

lemma comm_sq₂ (hf : ψ.comp f₁ = f₂.comp φ) (hf' : ψ'.comp f₂ = f₃.comp φ') :
  (ψ'.comp ψ).comp f₁ = f₃.comp (φ'.comp φ) :=
by rw [comp_assoc, hf, ← comp_assoc, hf', comp_assoc]

lemma map_comp_map (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ)
  (hf' : ψ'.comp f₂ = f₃.comp φ') (hg' : ψ'.comp g₂ = g₃.comp φ') :
  (map φ' ψ' hf' hg').comp (map φ ψ hf hg) =
    map (φ'.comp φ) (ψ'.comp ψ) (comm_sq₂ hf hf') (comm_sq₂ hg hg') :=
by { ext, refl }

lemma ι_norm_noninc : (ι f g).norm_noninc := λ v, le_rfl

/-- The lifting of a norm nonincreasing morphism is norm nonincreasing. -/
lemma lift_norm_noninc (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) (hφ : φ.norm_noninc) :
  (lift φ h).norm_noninc :=
hφ

/-- If `φ` satisfies `∥φ∥ ≤ C`, then the same is true for the lifted morphism. -/
lemma norm_lift_le (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ)
  (C : ℝ) (hφ : ∥φ∥ ≤ C) : ∥(lift φ h)∥ ≤ C := hφ

lemma map_norm_noninc (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ)
  (hφ : φ.norm_noninc) : (map φ ψ hf hg).norm_noninc :=
lift_norm_noninc _ _ $ hφ.comp ι_norm_noninc

lemma norm_map_le (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ)
  (C : ℝ) (hφ : ∥φ.comp (ι f₁ g₁)∥ ≤ C) : ∥map φ ψ hf hg∥ ≤ C :=
norm_lift_le _ _ _ hφ

end equalizer

end normed_group_hom

section controlled_closure
open filter finset
open_locale topological_space
variables {G : Type*} [normed_group G] [complete_space G]
variables {H : Type*} [normed_group H]

/-- Given `f : normed_group_hom G H` for some complete `G` and a subgroup `K` of `H`, if every
element `x` of `K` has a preimage under `f` whose norm is at most `C*∥x∥` then the same holds for
elements of the (topological) closure of `K` with constant `C+ε` instead of `C`, for any
positive `ε`.
-/
lemma controlled_closure_of_complete  {f : normed_group_hom G H} {K : add_subgroup H}
  {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : f.surjective_on_with K C) :
  f.surjective_on_with K.topological_closure (C + ε) :=
begin
  rintros (h : H) (h_in : h ∈ K.topological_closure),
  /- We first get rid of the easy case where `h = 0`.-/
  by_cases hyp_h : h = 0,
  { rw hyp_h,
    use 0,
    simp },
  /- The desired preimage will be constructed as the sum of a series. Convergence of
  the series will be guaranteed by completeness of `G`. We first write `h` as the sum
  of a sequence `v` of elements of `K` which starts close to `h` and then quickly goes to zero.
  The sequence `b` below quantifies this. -/
  set b : ℕ → ℝ := λ i, (1/2)^i*(ε*∥h∥/2)/C,
  have b_pos : ∀ i, 0 < b i,
  { intro i,
    field_simp [b, hC],
    exact div_pos (mul_pos hε (norm_pos_iff.mpr hyp_h))
                  (mul_pos (by norm_num : (0 : ℝ) < 2^i*2) hC) },
  obtain ⟨v : ℕ → H, lim_v : tendsto (λ (n : ℕ), ∑ k in range (n + 1), v k) at_top (𝓝 h),
    v_in : ∀ n, v n ∈ K, hv₀ : ∥v 0 - h∥ < b 0, hv : ∀ n > 0, ∥v n∥ < b n⟩ :=
    controlled_sum_of_mem_closure h_in b_pos,
  /- The controlled surjectivity assumption on `f` allows to build preimages `u n` for all
  elements `v n` of the `v` sequence.-/
  have : ∀ n, ∃ m' : G, f m' = v n ∧ ∥m'∥ ≤ C * ∥v n∥ := λ (n : ℕ), hyp (v n) (v_in n),
  choose u hu hnorm_u using this,
  /- The desired series `s` is then obtained by summing `u`. We then check our choice of
  `b` ensures `s` is Cauchy. -/
  set s : ℕ → G := λ n, ∑ k in range (n+1), u k,
  have : cauchy_seq s,
  { apply normed_group.cauchy_series_of_le_geometric'' (by norm_num) one_half_lt_one,
    rintro n (hn : n ≥ 1),
    calc ∥u n∥ ≤ C*∥v n∥ : hnorm_u n
    ... ≤ C * b n : mul_le_mul_of_nonneg_left (hv _ $ nat.succ_le_iff.mp hn).le hC.le
    ... = (1/2)^n * (ε * ∥h∥/2) : by simp [b, mul_div_cancel' _ hC.ne.symm]
    ... = (ε * ∥h∥/2) * (1/2)^n : mul_comm _ _ },
  /- We now show that the limit `g` of `s` is the desired preimage. -/
  obtain ⟨g : G, hg⟩ := cauchy_seq_tendsto_of_complete this,
  refine ⟨g, _, _⟩,
  { /- We indeed get a preimage. First note: -/
    have : f ∘ s = λ n, ∑ k in range (n + 1), v k,
    { ext n,
      simp [f.map_sum, hu] },
    /- In the above equality, the left-hand-side converges to `f g` by continuity of `f` and
       definition of `g` while the right-hand-side converges to `h` by construction of `v` so
       `g` is indeed a preimage of `h`. -/
    rw ← this at lim_v,
    exact tendsto_nhds_unique ((f.continuous.tendsto g).comp hg) lim_v },
  { /- Then we need to estimate the norm of `g`, using our careful choice of `b`. -/
    suffices : ∀ n, ∥s n∥ ≤ (C + ε) * ∥h∥,
      from le_of_tendsto' (continuous_norm.continuous_at.tendsto.comp hg) this,
    intros n,
    have hnorm₀ : ∥u 0∥ ≤ C*b 0 + C*∥h∥,
    { have := calc
      ∥v 0∥ ≤ ∥h∥ + ∥v 0 - h∥ : norm_le_insert' _ _
      ... ≤ ∥h∥ + b 0 : by apply add_le_add_left hv₀.le,
      calc ∥u 0∥ ≤ C*∥v 0∥ : hnorm_u 0
      ... ≤ C*(∥h∥ + b 0) : mul_le_mul_of_nonneg_left this hC.le
      ... = C * b 0 + C * ∥h∥ : by rw [add_comm, mul_add] },
    have : ∑ k in range (n + 1), C * b k ≤ ε * ∥h∥ := calc
      ∑ k in range (n + 1), C * b k = (∑ k in range (n + 1), (1 / 2) ^ k) * (ε * ∥h∥ / 2) :
                     by simp only [b, mul_div_cancel' _ hC.ne.symm, ← sum_mul]
      ... ≤  2 * (ε * ∥h∥ / 2) : mul_le_mul_of_nonneg_right (sum_geometric_two_le _)
                                                            (by nlinarith [hε, norm_nonneg h])
      ... = ε * ∥h∥ : mul_div_cancel' _ two_ne_zero,
    calc ∥s n∥ ≤ ∑ k in range (n+1), ∥u k∥ : norm_sum_le _ _
    ... = ∑ k in range n, ∥u (k + 1)∥ + ∥u 0∥ : sum_range_succ' _ _
    ... ≤ ∑ k in range n, C*∥v (k + 1)∥ + ∥u 0∥ : add_le_add_right (sum_le_sum (λ _ _, hnorm_u _)) _
    ... ≤ ∑ k in range n, C*b (k+1) + (C*b 0 + C*∥h∥) :
      add_le_add (sum_le_sum (λ k _, mul_le_mul_of_nonneg_left (hv _ k.succ_pos).le hC.le)) hnorm₀
    ... = ∑ k in range (n+1), C*b k + C*∥h∥ : by rw [← add_assoc, sum_range_succ']
    ... ≤ (C+ε)*∥h∥ : by { rw [add_comm, add_mul], apply add_le_add_left this } }
end

/-- Given `f : normed_group_hom G H` for some complete `G`, if every element `x` of the image of
an isometric immersion `j : normed_group_hom K H` has a preimage under `f` whose norm is at most
`C*∥x∥` then the same holds for elements of the (topological) closure of this image with constant
`C+ε` instead of `C`, for any positive `ε`.
This is useful in particular if `j` is the inclusion of a normed group into its completion
(in this case the closure is the full target group).
-/
lemma controlled_closure_range_of_complete {f : normed_group_hom G H}
  {K : Type*} [semi_normed_group K] {j : normed_group_hom K H} (hj : ∀ x, ∥j x∥ = ∥x∥)
  {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : ∀ k, ∃ g, f g = j k ∧ ∥g∥ ≤ C*∥k∥) :
  f.surjective_on_with j.range.topological_closure (C + ε) :=
begin
  replace hyp : ∀ h ∈ j.range, ∃ g, f g = h ∧ ∥g∥ ≤ C*∥h∥,
  { intros h h_in,
    rcases (j.mem_range _).mp h_in with ⟨k, rfl⟩,
    rw hj,
    exact hyp k },
  exact controlled_closure_of_complete hC hε hyp
end
end controlled_closure


import tactic.alias
import tactic.basic
import tactic.linarith

@[reducible]
def symbol := ℕ

/-- Representation of formulas in modal logic. -/
@[derive decidable_eq]
inductive formula : Type
| bottom : formula
| top : formula
| symbol (s : symbol) : formula
| not (a : formula) : formula
| and (a b : formula) : formula
| or (a b : formula) : formula
| implies (a b : formula) : formula
| iff (a b : formula) : formula
| box (a : formula) : formula
| diamond (a : formula) : formula

reserve infixr ` ⟶ ` :(std.prec.arrow+1)
reserve prefix `□` :40
reserve prefix `◇` :40

notation `⊥` := formula.bottom
notation `⊤` := formula.top
notation ¬ a := formula.not a
notation a ` ∧ ` b := (formula.and a b)
notation a ` ∨ ` b := formula.or a b
notation a ` ⟶ ` b := formula.implies a b
notation a ` ↔ ` b := formula.iff a b
notation □a := formula.box a
notation ◇a := formula.diamond a

-- Used to construct formulas containing arbitrary symbols e.g. `0 ∨ 1` (`p ∨ q`).
instance formula.has_zero : has_zero formula := { zero := formula.symbol 0 }
instance formula.has_one : has_one formula := { one := formula.symbol 1 }
instance formula.has_add : has_add formula := {
  add := λx y, match (x, y) with
  | (formula.symbol x, formula.symbol y) := formula.symbol (x + y)
  | (x, _) := x
  end
}

/-- A formula is modal free iff it contains no modal operators. -/
@[simp] def modal_free : formula → Prop
| ⊤ := true
| ⊥ := true
| (formula.symbol _) := true
| ¬a := modal_free a
| (a ∧ b) := modal_free a ∧ modal_free b
| (a ∨ b) := modal_free a ∧ modal_free b
| (a ⟶ b) := modal_free a ∧ modal_free b
| (a ↔ b) := modal_free a ∧ modal_free b
| □_ := false
| ◇_ := false

/-- Substitutes sentence symbols for formulas in a formula according to a mapping function. -/
@[simp] def subst (substs : symbol → formula) : formula → formula
| ⊤ := ⊤
| ⊥ := ⊥
| (formula.symbol s) := substs s
| ¬a := ¬subst a
| (a ∧ b) := subst a ∧ subst b
| (a ∨ b) := subst a ∨ subst b
| (a ⟶ b) := subst a ⟶ subst b
| (a ↔ b) := subst a ↔ subst b
| □a := □subst a
| ◇a := ◇subst a

@[simp] lemma subst.ident (a : formula) : subst formula.symbol a = a :=
begin
  induction a,
  repeat { simp [a_ih, subst] },
  repeat { simp },
  repeat { tauto },
end

@[simp] def substitution_inst (a b : formula) : Prop :=
∃substs, subst substs a = b