/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Isometries of emetric and metric spaces
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.bounded_continuous_function
import Mathlib.topology.compacts
import Mathlib.PostPort

universes u v w u_1 u_2 l

namespace Mathlib

/-!
# Isometries

We define isometries, i.e., maps between emetric spaces that preserve
the edistance (on metric spaces, these are exactly the maps that preserve distances),
and prove their basic properties. We also introduce isometric bijections.
-/

/-- An isometry (also known as isometric embedding) is a map preserving the edistance
between emetric spaces, or equivalently the distance between metric space.  -/
def isometry {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (f : α → β) :=
  ∀ (x1 x2 : α), edist (f x1) (f x2) = edist x1 x2

/-- On metric spaces, a map is an isometry if and only if it preserves distances. -/
theorem isometry_emetric_iff_metric {α : Type u} {β : Type v} [metric_space α] [metric_space β]
    {f : α → β} : isometry f ↔ ∀ (x y : α), dist (f x) (f y) = dist x y :=
  sorry

/-- An isometry preserves edistances. -/
theorem isometry.edist_eq {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {f : α → β}
    (hf : isometry f) (x : α) (y : α) : edist (f x) (f y) = edist x y :=
  hf x y

/-- An isometry preserves distances. -/
theorem isometry.dist_eq {α : Type u} {β : Type v} [metric_space α] [metric_space β] {f : α → β}
    (hf : isometry f) (x : α) (y : α) : dist (f x) (f y) = dist x y :=
  sorry

theorem isometry.lipschitz {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {f : α → β}
    (h : isometry f) : lipschitz_with 1 f :=
  lipschitz_with.of_edist_le fun (x y : α) => le_of_eq (h x y)

theorem isometry.antilipschitz {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {f : α → β} (h : isometry f) : antilipschitz_with 1 f :=
  sorry

/-- An isometry is injective -/
theorem isometry.injective {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {f : α → β}
    (h : isometry f) : function.injective f :=
  antilipschitz_with.injective (isometry.antilipschitz h)

/-- Any map on a subsingleton is an isometry -/
theorem isometry_subsingleton {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {f : α → β} [subsingleton α] : isometry f :=
  sorry

/-- The identity is an isometry -/
theorem isometry_id {α : Type u} [emetric_space α] : isometry id := fun (x y : α) => rfl

/-- The composition of isometries is an isometry -/
theorem isometry.comp {α : Type u} {β : Type v} {γ : Type w} [emetric_space α] [emetric_space β]
    [emetric_space γ] {g : β → γ} {f : α → β} (hg : isometry g) (hf : isometry f) :
    isometry (g ∘ f) :=
  fun (x y : α) => Eq.trans (hg (f x) (f y)) (hf x y)

/-- An isometry is an embedding -/
theorem isometry.uniform_embedding {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {f : α → β} (hf : isometry f) : uniform_embedding f :=
  antilipschitz_with.uniform_embedding (isometry.antilipschitz hf)
    (lipschitz_with.uniform_continuous (isometry.lipschitz hf))

/-- An isometry is continuous. -/
theorem isometry.continuous {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {f : α → β} (hf : isometry f) : continuous f :=
  lipschitz_with.continuous (isometry.lipschitz hf)

/-- The right inverse of an isometry is an isometry. -/
theorem isometry.right_inv {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {f : α → β}
    {g : β → α} (h : isometry f) (hg : function.right_inverse g f) : isometry g :=
  sorry

/-- Isometries preserve the diameter in emetric spaces. -/
theorem isometry.ediam_image {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {f : α → β} (hf : isometry f) (s : set α) : emetric.diam (f '' s) = emetric.diam s :=
  sorry

theorem isometry.ediam_range {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {f : α → β} (hf : isometry f) : emetric.diam (set.range f) = emetric.diam set.univ :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (emetric.diam (set.range f) = emetric.diam set.univ))
        (Eq.symm set.image_univ)))
    (isometry.ediam_image hf set.univ)

/-- The injection from a subtype is an isometry -/
theorem isometry_subtype_coe {α : Type u} [emetric_space α] {s : set α} : isometry coe :=
  fun (x y : ↥s) => rfl

/-- An isometry preserves the diameter in metric spaces. -/
theorem isometry.diam_image {α : Type u} {β : Type v} [metric_space α] [metric_space β] {f : α → β}
    (hf : isometry f) (s : set α) : metric.diam (f '' s) = metric.diam s :=
  sorry

theorem isometry.diam_range {α : Type u} {β : Type v} [metric_space α] [metric_space β] {f : α → β}
    (hf : isometry f) : metric.diam (set.range f) = metric.diam set.univ :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (metric.diam (set.range f) = metric.diam set.univ))
        (Eq.symm set.image_univ)))
    (isometry.diam_image hf set.univ)

namespace add_monoid_hom

theorem isometry_iff_norm {E : Type u_1} {F : Type u_2} [normed_group E] [normed_group F]
    (f : E →+ F) : isometry ⇑f ↔ ∀ (x : E), norm (coe_fn f x) = norm x :=
  sorry

theorem isometry_of_norm {E : Type u_1} {F : Type u_2} [normed_group E] [normed_group F]
    (f : E →+ F) (hf : ∀ (x : E), norm (coe_fn f x) = norm x) : isometry ⇑f :=
  iff.mpr (isometry_iff_norm f) hf

end add_monoid_hom

/-- `α` and `β` are isometric if there is an isometric bijection between them. -/
structure isometric (α : Type u_1) (β : Type u_2) [emetric_space α] [emetric_space β] extends α ≃ β
    where
  isometry_to_fun : isometry (equiv.to_fun _to_equiv)

infixl:25 " ≃ᵢ " => Mathlib.isometric

namespace isometric

protected instance has_coe_to_fun {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] :
    has_coe_to_fun (α ≃ᵢ β) :=
  has_coe_to_fun.mk (fun (_x : α ≃ᵢ β) => α → β) fun (e : α ≃ᵢ β) => ⇑(to_equiv e)

theorem coe_eq_to_equiv {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (h : α ≃ᵢ β)
    (a : α) : coe_fn h a = coe_fn (to_equiv h) a :=
  rfl

@[simp] theorem coe_to_equiv {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) : ⇑(to_equiv h) = ⇑h :=
  rfl

protected theorem isometry {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) : isometry ⇑h :=
  isometry_to_fun h

protected theorem edist_eq {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) (x : α) (y : α) : edist (coe_fn h x) (coe_fn h y) = edist x y :=
  isometry.edist_eq (isometric.isometry h) x y

protected theorem dist_eq {α : Type u_1} {β : Type u_2} [metric_space α] [metric_space β]
    (h : α ≃ᵢ β) (x : α) (y : α) : dist (coe_fn h x) (coe_fn h y) = dist x y :=
  isometry.dist_eq (isometric.isometry h) x y

protected theorem continuous {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) : continuous ⇑h :=
  isometry.continuous (isometric.isometry h)

@[simp] theorem ediam_image {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) (s : set α) : emetric.diam (⇑h '' s) = emetric.diam s :=
  isometry.ediam_image (isometric.isometry h) s

theorem to_equiv_inj {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {h₁ : α ≃ᵢ β}
    {h₂ : α ≃ᵢ β} : to_equiv h₁ = to_equiv h₂ → h₁ = h₂ :=
  sorry

theorem ext {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] {h₁ : α ≃ᵢ β}
    {h₂ : α ≃ᵢ β} (H : ∀ (x : α), coe_fn h₁ x = coe_fn h₂ x) : h₁ = h₂ :=
  to_equiv_inj (equiv.ext H)

/-- Alternative constructor for isometric bijections,
taking as input an isometry, and a right inverse. -/
def mk' {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (f : α → β) (g : β → α)
    (hfg : ∀ (x : β), f (g x) = x) (hf : isometry f) : α ≃ᵢ β :=
  mk (equiv.mk f g sorry hfg) hf

/-- The identity isometry of a space. -/
protected def refl (α : Type u_1) [emetric_space α] : α ≃ᵢ α :=
  mk (equiv.mk (equiv.to_fun (equiv.refl α)) (equiv.inv_fun (equiv.refl α)) sorry sorry) isometry_id

/-- The composition of two isometric isomorphisms, as an isometric isomorphism. -/
protected def trans {α : Type u} {β : Type v} {γ : Type w} [emetric_space α] [emetric_space β]
    [emetric_space γ] (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) : α ≃ᵢ γ :=
  mk
    (equiv.mk (equiv.to_fun (equiv.trans (to_equiv h₁) (to_equiv h₂)))
      (equiv.inv_fun (equiv.trans (to_equiv h₁) (to_equiv h₂))) sorry sorry)
    sorry

@[simp] theorem trans_apply {α : Type u} {β : Type v} {γ : Type w} [emetric_space α]
    [emetric_space β] [emetric_space γ] (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) (x : α) :
    coe_fn (isometric.trans h₁ h₂) x = coe_fn h₂ (coe_fn h₁ x) :=
  rfl

/-- The inverse of an isometric isomorphism, as an isometric isomorphism. -/
protected def symm {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (h : α ≃ᵢ β) :
    β ≃ᵢ α :=
  mk (equiv.symm (to_equiv h)) sorry

@[simp] theorem symm_symm {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) : isometric.symm (isometric.symm h) = h :=
  to_equiv_inj (equiv.symm_symm (to_equiv h))

@[simp] theorem apply_symm_apply {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) (y : β) : coe_fn h (coe_fn (isometric.symm h) y) = y :=
  equiv.apply_symm_apply (to_equiv h) y

@[simp] theorem symm_apply_apply {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) (x : α) : coe_fn (isometric.symm h) (coe_fn h x) = x :=
  equiv.symm_apply_apply (to_equiv h) x

theorem symm_apply_eq {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (h : α ≃ᵢ β)
    {x : α} {y : β} : coe_fn (isometric.symm h) y = x ↔ y = coe_fn h x :=
  equiv.symm_apply_eq (to_equiv h)

theorem eq_symm_apply {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (h : α ≃ᵢ β)
    {x : α} {y : β} : x = coe_fn (isometric.symm h) y ↔ coe_fn h x = y :=
  equiv.eq_symm_apply (to_equiv h)

theorem symm_comp_self {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (h : α ≃ᵢ β) :
    ⇑(isometric.symm h) ∘ ⇑h = id :=
  funext fun (a : α) => equiv.left_inv (to_equiv h) a

theorem self_comp_symm {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (h : α ≃ᵢ β) :
    ⇑h ∘ ⇑(isometric.symm h) = id :=
  funext fun (a : β) => equiv.right_inv (to_equiv h) a

@[simp] theorem range_eq_univ {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) : set.range ⇑h = set.univ :=
  set.eq_univ_of_forall
    fun (b : β) => Exists.intro (coe_fn (isometric.symm h) b) (congr_fun (self_comp_symm h) b)

theorem image_symm {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (h : α ≃ᵢ β) :
    set.image ⇑(isometric.symm h) = set.preimage ⇑h :=
  set.image_eq_preimage_of_inverse (equiv.left_inv (to_equiv (isometric.symm h)))
    (equiv.right_inv (to_equiv (isometric.symm h)))

theorem preimage_symm {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (h : α ≃ᵢ β) :
    set.preimage ⇑(isometric.symm h) = set.image ⇑h :=
  Eq.symm
    (set.image_eq_preimage_of_inverse (equiv.left_inv (to_equiv h)) (equiv.right_inv (to_equiv h)))

@[simp] theorem symm_trans_apply {α : Type u} {β : Type v} {γ : Type w} [emetric_space α]
    [emetric_space β] [emetric_space γ] (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) (x : γ) :
    coe_fn (isometric.symm (isometric.trans h₁ h₂)) x =
        coe_fn (isometric.symm h₁) (coe_fn (isometric.symm h₂) x) :=
  rfl

theorem ediam_univ {α : Type u} {β : Type v} [emetric_space α] [emetric_space β] (h : α ≃ᵢ β) :
    emetric.diam set.univ = emetric.diam set.univ :=
  sorry

@[simp] theorem ediam_preimage {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) (s : set β) : emetric.diam (⇑h ⁻¹' s) = emetric.diam s :=
  sorry

/-- The (bundled) homeomorphism associated to an isometric isomorphism. -/
protected def to_homeomorph {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) : α ≃ₜ β :=
  homeomorph.mk (to_equiv h)

@[simp] theorem coe_to_homeomorph {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) : ⇑(isometric.to_homeomorph h) = ⇑h :=
  rfl

@[simp] theorem coe_to_homeomorph_symm {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) : ⇑(homeomorph.symm (isometric.to_homeomorph h)) = ⇑(isometric.symm h) :=
  rfl

@[simp] theorem to_homeomorph_to_equiv {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    (h : α ≃ᵢ β) : homeomorph.to_equiv (isometric.to_homeomorph h) = to_equiv h :=
  rfl

@[simp] theorem comp_continuous_on_iff {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {γ : Type u_1} [topological_space γ] (h : α ≃ᵢ β) {f : γ → α} {s : set γ} :
    continuous_on (⇑h ∘ f) s ↔ continuous_on f s :=
  homeomorph.comp_continuous_on_iff (isometric.to_homeomorph h) f s

@[simp] theorem comp_continuous_iff {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {γ : Type u_1} [topological_space γ] (h : α ≃ᵢ β) {f : γ → α} :
    continuous (⇑h ∘ f) ↔ continuous f :=
  homeomorph.comp_continuous_iff (isometric.to_homeomorph h)

@[simp] theorem comp_continuous_iff' {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {γ : Type u_1} [topological_space γ] (h : α ≃ᵢ β) {f : β → γ} :
    continuous (f ∘ ⇑h) ↔ continuous f :=
  homeomorph.comp_continuous_iff' (isometric.to_homeomorph h)

/-- The group of isometries. -/
protected instance group {α : Type u} [emetric_space α] : group (α ≃ᵢ α) :=
  group.mk (fun (e₁ e₂ : α ≃ᵢ α) => isometric.trans e₂ e₁) sorry (isometric.refl α) sorry sorry
    isometric.symm
    (div_inv_monoid.div._default (fun (e₁ e₂ : α ≃ᵢ α) => isometric.trans e₂ e₁) sorry
      (isometric.refl α) sorry sorry isometric.symm)
    sorry

@[simp] theorem coe_one {α : Type u} [emetric_space α] : ⇑1 = id := rfl

@[simp] theorem coe_mul {α : Type u} [emetric_space α] (e₁ : α ≃ᵢ α) (e₂ : α ≃ᵢ α) :
    ⇑(e₁ * e₂) = ⇑e₁ ∘ ⇑e₂ :=
  rfl

theorem mul_apply {α : Type u} [emetric_space α] (e₁ : α ≃ᵢ α) (e₂ : α ≃ᵢ α) (x : α) :
    coe_fn (e₁ * e₂) x = coe_fn e₁ (coe_fn e₂ x) :=
  rfl

@[simp] theorem inv_apply_self {α : Type u} [emetric_space α] (e : α ≃ᵢ α) (x : α) :
    coe_fn (e⁻¹) (coe_fn e x) = x :=
  symm_apply_apply e x

@[simp] theorem apply_inv_self {α : Type u} [emetric_space α] (e : α ≃ᵢ α) (x : α) :
    coe_fn e (coe_fn (e⁻¹) x) = x :=
  apply_symm_apply e x

/-- Addition `y ↦ y + x` as an `isometry`. -/
protected def add_right {G : Type u_1} [normed_group G] (x : G) : G ≃ᵢ G :=
  mk (equiv.mk (equiv.to_fun (equiv.add_right x)) (equiv.inv_fun (equiv.add_right x)) sorry sorry)
    sorry

@[simp] theorem add_right_to_equiv {G : Type u_1} [normed_group G] (x : G) :
    to_equiv (isometric.add_right x) = equiv.add_right x :=
  rfl

@[simp] theorem coe_add_right {G : Type u_1} [normed_group G] (x : G) :
    ⇑(isometric.add_right x) = fun (y : G) => y + x :=
  rfl

theorem add_right_apply {G : Type u_1} [normed_group G] (x : G) (y : G) :
    coe_fn (isometric.add_right x) y = y + x :=
  rfl

@[simp] theorem add_right_symm {G : Type u_1} [normed_group G] (x : G) :
    isometric.symm (isometric.add_right x) = isometric.add_right (-x) :=
  ext fun (y : G) => rfl

/-- Addition `y ↦ x + y` as an `isometry`. -/
protected def add_left {G : Type u_1} [normed_group G] (x : G) : G ≃ᵢ G :=
  mk (equiv.add_left x) sorry

@[simp] theorem add_left_to_equiv {G : Type u_1} [normed_group G] (x : G) :
    to_equiv (isometric.add_left x) = equiv.add_left x :=
  rfl

@[simp] theorem coe_add_left {G : Type u_1} [normed_group G] (x : G) :
    ⇑(isometric.add_left x) = Add.add x :=
  rfl

@[simp] theorem add_left_symm {G : Type u_1} [normed_group G] (x : G) :
    isometric.symm (isometric.add_left x) = isometric.add_left (-x) :=
  ext fun (y : G) => rfl

/-- Negation `x ↦ -x` as an `isometry`. -/
protected def neg (G : Type u_1) [normed_group G] : G ≃ᵢ G := mk (equiv.neg G) sorry

@[simp] theorem neg_symm {G : Type u_1} [normed_group G] :
    isometric.symm (isometric.neg G) = isometric.neg G :=
  rfl

@[simp] theorem neg_to_equiv {G : Type u_1} [normed_group G] :
    to_equiv (isometric.neg G) = equiv.neg G :=
  rfl

@[simp] theorem coe_neg {G : Type u_1} [normed_group G] : ⇑(isometric.neg G) = Neg.neg := rfl

end isometric

namespace isometric

@[simp] theorem diam_image {α : Type u} {β : Type v} [metric_space α] [metric_space β] (h : α ≃ᵢ β)
    (s : set α) : metric.diam (⇑h '' s) = metric.diam s :=
  isometry.diam_image (isometric.isometry h) s

@[simp] theorem diam_preimage {α : Type u} {β : Type v} [metric_space α] [metric_space β]
    (h : α ≃ᵢ β) (s : set β) : metric.diam (⇑h ⁻¹' s) = metric.diam s :=
  sorry

theorem diam_univ {α : Type u} {β : Type v} [metric_space α] [metric_space β] (h : α ≃ᵢ β) :
    metric.diam set.univ = metric.diam set.univ :=
  congr_arg ennreal.to_real (ediam_univ h)

end isometric

/-- An isometry induces an isometric isomorphism between the source space and the
range of the isometry. -/
def isometry.isometric_on_range {α : Type u} {β : Type v} [emetric_space α] [emetric_space β]
    {f : α → β} (h : isometry f) : α ≃ᵢ ↥(set.range f) :=
  isometric.mk
    (equiv.mk (equiv.to_fun (equiv.set.range f (isometry.injective h)))
      (equiv.inv_fun (equiv.set.range f (isometry.injective h))) sorry sorry)
    sorry

@[simp] theorem isometry.isometric_on_range_apply {α : Type u} {β : Type v} [emetric_space α]
    [emetric_space β] {f : α → β} (h : isometry f) (x : α) :
    coe_fn (isometry.isometric_on_range h) x = { val := f x, property := set.mem_range_self x } :=
  rfl

/-- In a normed algebra, the inclusion of the base field in the extended field is an isometry. -/
theorem algebra_map_isometry (𝕜 : Type u_1) (𝕜' : Type u_2) [normed_field 𝕜] [normed_ring 𝕜']
    [normed_algebra 𝕜 𝕜'] : isometry ⇑(algebra_map 𝕜 𝕜') :=
  sorry

/-- The space of bounded sequences, with its sup norm -/
def ℓ_infty_ℝ := bounded_continuous_function ℕ ℝ

namespace Kuratowski_embedding

/-! ### In this section, we show that any separable metric space can be embedded isometrically in ℓ^∞(ℝ) -/

/-- A metric space can be embedded in `l^∞(ℝ)` via the distances to points in
a fixed countable set, if this set is dense. This map is given in the next definition,
without density assumptions. -/
def embedding_of_subset {α : Type u} [metric_space α] (x : ℕ → α) (a : α) : ℓ_infty_ℝ :=
  bounded_continuous_function.of_normed_group_discrete
    (fun (n : ℕ) => dist a (x n) - dist (x 0) (x n)) (dist a (x 0)) sorry

theorem embedding_of_subset_coe {α : Type u} {n : ℕ} [metric_space α] (x : ℕ → α) (a : α) :
    coe_fn (embedding_of_subset x a) n = dist a (x n) - dist (x 0) (x n) :=
  rfl

/-- The embedding map is always a semi-contraction. -/
theorem embedding_of_subset_dist_le {α : Type u} [metric_space α] (x : ℕ → α) (a : α) (b : α) :
    dist (embedding_of_subset x a) (embedding_of_subset x b) ≤ dist a b :=
  sorry

/-- When the reference set is dense, the embedding map is an isometry on its image. -/
theorem embedding_of_subset_isometry {α : Type u} [metric_space α] (x : ℕ → α) (H : dense_range x) :
    isometry (embedding_of_subset x) :=
  sorry

/-- Every separable metric space embeds isometrically in ℓ_infty_ℝ. -/
theorem exists_isometric_embedding (α : Type u) [metric_space α]
    [topological_space.separable_space α] : ∃ (f : α → ℓ_infty_ℝ), isometry f :=
  sorry

end Kuratowski_embedding

/-- The Kuratowski embedding is an isometric embedding of a separable metric space in ℓ^∞(ℝ) -/
def Kuratowski_embedding (α : Type u) [metric_space α] [topological_space.separable_space α] :
    α → ℓ_infty_ℝ :=
  classical.some sorry

/-- The Kuratowski embedding is an isometry -/
protected theorem Kuratowski_embedding.isometry (α : Type u) [metric_space α]
    [topological_space.separable_space α] : isometry (Kuratowski_embedding α) :=
  classical.some_spec (Kuratowski_embedding.exists_isometric_embedding α)

/-- Version of the Kuratowski embedding for nonempty compacts -/
def nonempty_compacts.Kuratowski_embedding (α : Type u) [metric_space α] [compact_space α]
    [Nonempty α] : topological_space.nonempty_compacts ℓ_infty_ℝ :=
  { val := set.range (Kuratowski_embedding α), property := sorry }

end Mathlib


/-
Authore: Andrea Delmastro
-/
import tactic.induction
import order.min_max
import data.nat.basic

import IMP_op_sem
open aexp
open bexp
open com
open big_step

/-!
# Tipi per la sicurezza per IMP

Questo file definisce un sistema di tipi per IMP per garantire una semplice proprietà di sicurezza:
l’assenza di flussi di dati privati verso osservatori pubblici, e ne prova la correttezza.

## Note di implementazione

Questo file utilizza i tattici `cases'` e `induction'` definiti in `tactic.induction`.
Nonostante le medesime dimostrazioni siano ottenibili tramite i tattici `cases` e `induction`
classici, le due versioni qui utilizzate meglio si prestano all'utilizzo con predicati induttivi e
sono più 'naturali' rispetto alla medesima dimostrazione svolta su carta.

## Notazione

* `vname` : nome di variabile, `string`
* `val` : valore di un'espressione, `ℕ`
* `pstate` : stato di programma, funzione da `vname` a `val`
* `emp` : stato vuoto, assegna ad ogni variabile il valore 0
* `lv` : livello di sicurezza, `ℕ`
* `s [ x  ↦  v ]` : aggiornamento dello stato `s`, con assegnazione di `v` a `x`
* `::=` : comando di assegnamento
* `;;` : concatenazione sequenziale di comandi
* `IF THEN ELSE` : comando ramificazione condizionale
* `WHILE DO` : comando di ciclo
* `conf` : configurazione, coppia `com × pstate`
* `⟹` : relazione big-step

## Risultati principali

* `noninterference : ∀ {c : com} {s s' t t' : pstate} {l : lv}, (c, s) ⟹ s' → (c, t) ⟹ t' → (0 ⊢. c) → s = t [<= l] → s' = t' [<= l]`

## Riferimenti

* [Nipkow, Klein, Concrete Semantics with Isabelle/HOL][Nipkow]
-/

abbreviation lv := ℕ

/--
Funzione che associa ad ogni variabile un livello di sicurezza determinato dalla lunghezza del
suo nome.
-/
def sec : vname → lv :=
  λ (x : vname), x.length

/--
Funzione che associa ad ogni espressione aritmetica un livello di sicurezza calcolato come il
massimo tra i livelli di sicurezza delle variabili che vi compaiono.
-/
def secₐ : aexp → lv
| (N n)        := 0
| (V x)        := sec x
| (Plus a₁ a₂) := max (secₐ a₁) (secₐ a₂)

/--
Funzione che associa ad ogni espressione booleana un livello di sicurezza calcolato come il
massimo tra i livelli di sicurezza delle variabili che vi compaiono.
-/
def sec₆ : bexp → lv
| (Bc v)       := 0
| (Not b)      := sec₆ b
| (And b₁ b₂)  := max (sec₆ b₁) (sec₆ b₂)
| (Less a₁ a₂) := max (secₐ a₁) (secₐ a₂)

notation s ` = ` t ` [<= ` l `]` := ∀ (z : vname), (sec z <= l) → s z = t z
notation s ` = ` t ` [< ` l `]` := ∀ (z : vname), (sec z < l) → s z = t z

namespace state_eq_below_lv

/-!
### Equivalenza tra stati al di sotto di una soglia di sicurezza (<)

Vengono dimostrate alcune semplici proprietà relativamente alle definizioni di equivalenza tra stati
al di sotto di una soglia di sicurezza.
-/

lemma refl {s : pstate} {l : lv} : s = s [< l] :=
begin
  intros,
  reflexivity
end

lemma trans {s₁ s₂ s₃ : pstate} {l : lv} :
  s₁ = s₂ [< l] → s₂ = s₃ [< l] → s₁ = s₃ [< l] :=
begin
  intros _ _ x _,
  have : s₁ x = s₂ x, from ‹s₁ = s₂ [< l]› x ‹sec x < l›,
  have : s₂ x = s₃ x, from ‹s₂ = s₃ [< l]› x ‹sec x < l›,
  show s₁ x = s₃ x, from trans ‹s₁ x = s₂ x› ‹s₂ x = s₃ x›
end

lemma symm {s t : pstate} {l : lv} :
  s = t [< l] → t = s [< l] :=
begin
  intros _ x _,
  show t x = s x, from symm (‹s = t [< l]› x ‹sec x < l›)
end

lemma restrict {s t : pstate} {l₁ l₂ : lv} :
  s = t [< l₁] → (l₂ < l₁) → s = t [<= l₂] :=
begin
  intros _ _ x _,
  have : sec x < l₁, from gt_of_gt_of_ge ‹l₂ < l₁› ‹sec x <= l₂›,
  show s x = t x, from ‹s = t [< l₁]› x ‹sec x < l₁›
end

end state_eq_below_lv

open state_eq_below_lv

namespace state_eq_beloweq_lv

/-!
### Equivalenza tra stati al di sotto di una soglia di sicurezza (<=)

Vengono dimostrate alcune semplici proprietà relativamente alle definizioni di equivalenza tra stati
al di sotto di una soglia di sicurezza.
-/

lemma refl {s : pstate} {l : lv} : s = s [<= l] :=
begin
  intros,
  reflexivity
end

lemma trans {s₁ s₂ s₃ : pstate} {l : lv} :
  s₁ = s₂ [<= l] → s₂ = s₃ [<= l] → s₁ = s₃ [<= l] :=
begin
  intros _ _ x _,
  have : s₁ x = s₂ x, from ‹s₁ = s₂ [<= l]› x ‹sec x <= l›,
  have : s₂ x = s₃ x, from ‹s₂ = s₃ [<= l]› x ‹sec x <= l›,
  show s₁ x = s₃ x, from trans ‹s₁ x = s₂ x› ‹s₂ x = s₃ x›
end

lemma symm {s t : pstate} {l : lv} :
  s = t [<= l] → t = s [<= l] :=
begin
  intros _ x _,
  show t x = s x, from symm (‹s = t [<= l]› x ‹sec x <= l›)
end

lemma restrict {s t : pstate} {l₁ l₂ : lv} :
  s = t [<= l₁] → (l₂ < l₁) → s = t [<= l₂] :=
begin
  intros _ _ x _,
  have : sec x <= l₁, from le_of_lt (gt_of_gt_of_ge ‹l₂ < l₁› ‹sec x <= l₂›),
  show s x = t x, from ‹s = t [<= l₁]› x ‹sec x <= l₁›
end

end state_eq_beloweq_lv

open state_eq_beloweq_lv

/--
Lemma di noninterferenza per espressioni aritmetiche: la valutazione di un'espressione aritmetica
in due stati uguali al di sotto di una soglia di sicurezza produce il medesimo valore se il livello
di sicurezza associato all'espressione è al di sotto della soglia.
-/
lemma noninterference_aexp {s t : pstate} {l : lv} {a : aexp} :
  s = t [<= l] → (secₐ a <= l) → (aval a s = aval a t) :=
begin
  intros,
  induction' a,
    case N : {
      trivial
    },
    case V : x {
      show aval (V x) s = aval (V x) t, by
        simp[aval, ‹s = t [<= l]› x ‹sec x ≤ l›]
    },
    case Plus : a₁ a₂ ih₁ ih₂ {
      have : (secₐ a₁ <= l) ∧ (secₐ a₂ <= l), from
         max_le_iff.elim_left ‹max (secₐ a₁) (secₐ a₂) ≤ l›,
      cases' ‹(secₐ a₁ <= l) ∧ (secₐ a₂ <= l)›,

      have : aval a₁ s = aval a₁ t, from ih₁ ‹s = t [<= l]› ‹(secₐ a₁ <= l)›,
      have : aval a₂ s = aval a₂ t, from ih₂ ‹s = t [<= l]› ‹(secₐ a₂ <= l)›,

      show aval (Plus a₁ a₂) s = aval (Plus a₁ a₂) t, by
        simp[aval, ‹aval a₁ s = aval a₁ t›, ‹aval a₂ s = aval a₂ t›]
    }
end

/--
Lemma di noninterferenza per espressioni booleane: la valutazione di un'espressione booleana
in due stati uguali al di sotto di una soglia di sicurezza produce il medesimo valore se il livello
di sicurezza associato all'espressione è al di sotto della soglia.
-/
lemma noninterference_bexp {s t : pstate} {l : lv} {b : bexp} :
  s = t [<= l] → (sec₆ b <= l) → (bval b s = bval b t) :=
begin
  intros,
  induction' b,
    case Bc : {
      trivial
    },
    case Not : {
      have : bval b s = bval b t, from
        ih ‹s = t [<= l]› ‹sec₆ b ≤ l›,

      show bval (Not b) s = bval (Not b) t, by
        simp[bval, ‹bval b s = bval b t›]
    },
    case And : b₁ b₂ ih₁ ih₂ {
      have : (sec₆ b₁ <= l) ∧ (sec₆ b₂ <= l), from
        max_le_iff.elim_left ‹max (sec₆ b₁) (sec₆ b₂) <= l›,
      cases' ‹(sec₆ b₁ <= l) ∧ (sec₆ b₂ <= l)›,

      have : bval b₁ s = bval b₁ t, from ih₁ ‹s = t [<= l]› ‹sec₆ b₁ ≤ l›,
      have : bval b₂ s = bval b₂ t, from ih₂ ‹s = t [<= l]› ‹sec₆ b₂ ≤ l›,

      show bval (And b₁ b₂) s = bval (And b₁ b₂) t, by
        simp[bval, ‹bval b₁ s = bval b₁ t›, ‹bval b₂ s = bval b₂ t›]
    },
    case Less : a₁ a₂ {
      have : (secₐ a₁ <= l) ∧ (secₐ a₂ <= l), from
        max_le_iff.elim_left ‹max (secₐ a₁) (secₐ a₂) ≤ l›,
      cases' ‹(secₐ a₁ <= l) ∧ (secₐ a₂ <= l)›,

      have : aval a₁ s = aval a₁ t, from
        noninterference_aexp ‹s = t [<= l]› ‹(secₐ a₁ <= l)›,
      have : aval a₂ s = aval a₂ t, from
        noninterference_aexp ‹s = t [<= l]› ‹(secₐ a₂ <= l)›,

      show bval (Less a₁ a₂) s = bval (Less a₁ a₂) t, by
        simp[bval, ‹aval a₁ s = aval a₁ t›, ‹aval a₂ s = aval a₂ t›]
    }
end

/-!
### Giudizi per i comandi

Il sistema permette di derivare giudizi della forma: `l ⊢. c` se ogni flusso di informazione
entro `c` è crescente rispetto al livello di sicurezza (da livello basso a livello alto) e avviene
verso variabili di livello maggiore o uguale a `l`.
-/

inductive sec_type : lv → com → Prop
| Skip {l : lv} :
  sec_type l SKIP

| Assign {x : vname} {a : aexp} {l : lv} :
  secₐ a <= sec x →
  l <= sec x →
  sec_type l (x ::= a)

| Seq {l : lv} {c₁ c₂ : com} :
  sec_type l c₁ →
  sec_type l c₂ →
  sec_type l (c₁ ;; c₂)

| If {b : bexp} {l : lv} {c₁ c₂ : com} :
  sec_type (max l (sec₆ b)) c₁ →
  sec_type (max l (sec₆ b)) c₂ →
  sec_type l (IF b THEN c₁ ELSE c₂)

| While {b : bexp} {l : lv} {c : com} :
  sec_type (max l (sec₆ b)) c →
  sec_type l (WHILE b DO c)

infix ` ⊢. `:50 := sec_type

open sec_type

/--
Lemma di anti monotonicità: è possibile abbassare il livello sotto il quale non sono permessi
assegnamenti, mantenendo il comando ben tipato.
-/
lemma anti_monotonicity {l l' : lv} {c : com} :
  (l ⊢. c) → (l' <= l) → (l' ⊢. c) :=
begin
  intros,
  induction' ‹l ⊢. c›,
    case Skip : {
      show l' ⊢. SKIP, from Skip
    },
    case Assign : {
      have : l' <= sec x, from le_trans ‹l' <= l› ‹l <= sec x›,

      show l' ⊢. x ::= a, from Assign ‹secₐ a ≤ sec x› ‹l' <= sec x›
    },
    case Seq : l c₁ c₂ _ _ ih₁ ih₂ {
      have : l' ⊢. c₁, from ih₁ ‹l' <= l›,
      have : l' ⊢. c₂, from ih₂ ‹l' <= l›,

      show l' ⊢. c₁ ;; c₂, from Seq ‹l' ⊢. c₁› ‹ l' ⊢. c₂›
    },
    case If : _ _ c₁ c₂ _ _ ih₁ ih₂ {
      have : max l' (sec₆ b) <= max l (sec₆ b), from max_le_max ‹l' ≤ l› (le_refl _) ,

      have : max l' (sec₆ b) ⊢. c₁, from ih₁ ‹max l' (sec₆ b) <= max l (sec₆ b)›,
      have : max l' (sec₆ b) ⊢. c₂, from ih₂ ‹max l' (sec₆ b) <= max l (sec₆ b)›,

      show l' ⊢. IF b THEN c₁ ELSE c₂, from
        If ‹max l' (sec₆ b) ⊢. c₁› ‹max l' (sec₆ b) ⊢. c₂›
    },
    case While : {
      have : max l' (sec₆ b) <= max l (sec₆ b), from max_le_max ‹l' ≤ l› (le_refl _),

      have : max l' (sec₆ b) ⊢. c, from ih ‹max l' (sec₆ b) <= max l (sec₆ b)›,

      show l' ⊢. WHILE b DO c, from While ‹max l' (sec₆ b) ⊢. c›
    }
end

/--
Lemma di confinamento: un comando `c` ben tipato in un livello `l` ha effetto esclusivamente sulle
variabili di livello superiore o ugale a `l`.
-/
lemma confinement {c : com} {s t : pstate} {l : lv} :
  (c, s) ⟹ t → (l ⊢. c) → s = t [< l] :=
begin
  intros _ _,
  induction' ‹(c, s) ⟹ t›,
    case Skip : {
      show t = t [< l], from refl
    },
    case Assign : {
      intros,

      cases' ‹l ⊢. x ::= a›,

      have : (z = x) ∨ (z ≠ x), from em (z = x),
      cases' ‹(z = x) ∨ (z ≠ x)›,
        case or.inl : {
          rw ‹z = x› at *,
          have : ¬(sec x < l), from not_lt_of_le ‹l ≤ sec x›,
          contradiction
        },
        case or.inr : {
          show t z = t[x ↦ aval a t] z, by simp[‹z ≠ x›]
        }
    },
    case Seq :  _ _ s s' t _ _ ih₁ ih₂{
      cases' ‹l ⊢. c₁ ;; c₂›,

      have : s = s' [< l], from ih₁ ‹l ⊢. c₁›,
      have : s' = t [< l], from ih₂ ‹l ⊢. c₂›,

      show s = t [< l], from trans ‹s = s' [< l]› ‹s' = t [< l]›
    },
    case IfTrue : {
      cases' ‹l ⊢. IF b THEN c₁ ELSE c₂›,

      have : l <= max l (sec₆ b), from le_max_left l (sec₆ b),
      have : l ⊢. c₁, from anti_monotonicity ‹max l (sec₆ b) ⊢. c₁› ‹l <= max  l (sec₆ b)›,

      show s = t [< l], from ih ‹l ⊢. c₁›
    },
    case IfFalse : {
      cases' ‹l ⊢. IF b THEN c₁ ELSE c₂›,

      have : l <= max l (sec₆ b), from le_max_left l (sec₆ b),
      have : l ⊢. c₂, from anti_monotonicity ‹max l (sec₆ b) ⊢. c₂› ‹l <= max l (sec₆ b)›,

      show s = t [< l], from ih ‹l ⊢. c₂›
    },
    case WhileTrue : _ _ s s' t _ _ _ ih₁ ih₂ {
      cases' ‹l ⊢. WHILE b DO c›,

      have : l <= max l (sec₆ b), from le_max_left l (sec₆ b),
      have : l ⊢. c, from anti_monotonicity ‹max l (sec₆ b) ⊢. c› ‹l <= max l (sec₆ b)›,

      have : s = s' [< l], from ih₁ ‹l ⊢. c›,
      have : s' = t [< l], from ih₂ (While ‹max l (sec₆ b) ⊢. c›),

      show s = t [< l], from trans ‹s = s' [< l]› ‹s'= t [< l]›
    },
    case WhileFalse : {
      show t = t [< l], from refl
    }
end

/--
Teorema di non interferenza: dimostra la correttezza del sistema di tipi, mostrando come la
gli output inferiori o uguali ad una data soglia di sicurezza `l` non siano influenzati dagli
input di livello superiore a `l`.
-/
theorem noninterference {c : com} {s s' t t' : pstate} {l : lv}:
  (c, s) ⟹ s' → (c, t) ⟹ t' → (0 ⊢. c) → s = t [<= l] → s' = t' [<= l] :=
begin
  intro,
  revert t t',
  induction' ‹(c, s) ⟹ s'›,
    all_goals { intros _ _ _ _ _ },
    case Skip : {
      cases' ‹(SKIP, t) ⟹ t'›,

      show s' = t' [<= l], by assumption
    },
    case Assign : s _ _ {
      intros,
      cases' ‹(x ::= a, t) ⟹ t'› with _ t _,
      cases' ‹0 ⊢. x ::= a›,

      have : (sec x <= l) ∨ (sec x > l), from le_or_lt (sec x) l,
      have : (z = x) ∨ (z ≠ x), from em (z = x),

      cases' ‹(z = x) ∨ (z ≠ x)›,
        case inl : {
          simp[‹z = x›] at *,
          cases' ‹(sec x <= l) ∨ (sec x > l)›,
            case inl : {
              have : secₐ a <= l, from trans ‹secₐ a ≤ sec x› ‹sec x ≤ l›,
              show aval a s = aval a t, from noninterference_aexp ‹s = t [<= l]› ‹secₐ a <= l›
            },
            case inr : {
              have : ¬(sec x <= l), from not_le_of_gt ‹sec x > l›,
              contradiction
            }
        },
        case inr : {
          simp[‹z ≠ x›],
          show s z = t z, from ‹s = t [<= l]› z ‹sec z ≤ l›
        }
    },
    case Seq : _ _ s s₁ s' _ _ ih₁ ih₂ {
      cases' ‹(c₁ ;; c₂, t) ⟹ t'› with _ _ _ _ _ _ t t₁,
      cases' ‹0 ⊢. c₁ ;; c₂›,

      have : s₁ = t₁ [<= l], from ih₁ ‹(c₁, t) ⟹ t₁› ‹0 ⊢. c₁› ‹s = t [<= l]›,

      show s' = t' [<= l], from ih₂ ‹(c₂, t₁) ⟹ t'› ‹0 ⊢. c₂› ‹s₁ = t₁ [<= l]›
    },
    case IfTrue : {
      cases' ‹0 ⊢. IF b THEN c₁ ELSE c₂›,

      have : sec₆ b ⊢. c₁, by simpa[nat.zero_max] using ‹max 0 (sec₆ b) ⊢. c₁›,
      have : sec₆ b ⊢. c₂, by simpa[nat.zero_max] using ‹max 0 (sec₆ b) ⊢. c₂›,

      cases ‹(IF b THEN c₁ ELSE c₂, t) ⟹ t'›,
        case IfTrue : { -- IfTrue, IfTrue
          have : 0 <= sec₆ b, from nat.zero_le (sec₆ b),
          have : 0 ⊢. c₁, from anti_monotonicity ‹sec₆ b ⊢. c₁› ‹0 <= sec₆ b›,

          show s' = t' [<= l], from ih ‹(c₁, t) ⟹ t'› ‹0 ⊢. c₁› ‹s = t [<= l]›
        },
        case IfFalse : {
          have : (sec₆ b <= l) ∨ (sec₆ b > l), from le_or_lt (sec₆ b) l,
          cases' ‹(sec₆ b <= l) ∨ (sec₆ b > l)›,
            case inr : { -- IfTrue, IfFalse, (sec₆ b > l)
              have : s = s' [< sec₆ b], from confinement ‹(c₁, s) ⟹ s'› ‹sec₆ b ⊢. c₁›,
              have : t = t' [< sec₆ b], from confinement ‹(c₂, t) ⟹ t'› ‹sec₆ b ⊢. c₂›,

              have : s = s' [<= l], from restrict ‹s = s' [< sec₆ b]› ‹sec₆ b > l›,
              have : t = t' [<= l], from restrict ‹t = t' [< sec₆ b]› ‹sec₆ b > l›,

              show s' = t' [<= l], from
                trans (trans (symm ‹s = s' [<= l]›) ‹s = t [<= l]›) ‹t = t' [<= l]›
            },
            case inl : { -- IfTrue, IfFalse, (sec₆ b <= l)
              rw[noninterference_bexp ‹s = t [<= l]› ‹sec₆ b ≤ l›] at *,
              contradiction
            }
        }
    },
    case IfFalse : {
      cases' ‹0 ⊢. IF b THEN c₁ ELSE c₂›,

      have : sec₆ b ⊢. c₁, by simpa[nat.zero_max] using ‹max 0 (sec₆ b) ⊢. c₁›,
      have : sec₆ b ⊢. c₂, by simpa[nat.zero_max] using ‹max 0 (sec₆ b) ⊢. c₂›,

      cases ‹(IF b THEN c₁ ELSE c₂, t) ⟹ t'›,
        case IfFalse : { -- IfFalse, IfFalse
          have : 0 <= sec₆ b, from nat.zero_le (sec₆ b),
          have : 0 ⊢. c₂, from anti_monotonicity ‹sec₆ b ⊢. c₂› ‹0 <= sec₆ b›,

          show s' = t' [<= l], from ih ‹(c₂, t) ⟹ t'› ‹0 ⊢. c₂› ‹s = t [<= l]›
        },
        case IfTrue : {
          have : (sec₆ b <= l) ∨ (sec₆ b > l), from le_or_lt (sec₆ b) l,
          cases' ‹(sec₆ b <= l) ∨ (sec₆ b > l)›,
            case inr : { -- IfFalse, IfTrue, (sec₆ b > l)
              have : s = s' [< sec₆ b], from confinement ‹(c₂, s) ⟹ s'› ‹sec₆ b ⊢. c₂›,
              have : t = t' [< sec₆ b], from confinement ‹(c₁, t) ⟹ t'› ‹sec₆ b ⊢. c₁›,

              have : s = s' [<= l], from restrict ‹s = s' [< sec₆ b]› ‹sec₆ b > l›,
              have : t = t' [<= l], from restrict ‹t = t' [< sec₆ b]› ‹sec₆ b > l›,

              show s' = t' [<= l], from
                trans (trans (symm ‹s = s' [<= l]›) ‹s = t [<= l]›) ‹t = t' [<= l]›
            },
            case inl : { -- IfFalse, IfTrue, (sec₆ b <= l)
              rw[noninterference_bexp ‹s = t [<= l]› ‹sec₆ b ≤ l›] at *,
              contradiction
            }
        }
    },
    case WhileTrue : _ _ s s₁ s' _ _ _ ih₁ ih₂ {
      cases' ‹0 ⊢. WHILE b DO c›,

      have : sec₆ b ⊢. c, by simpa[nat.zero_max] using ‹max 0 (sec₆ b) ⊢. c›,

      cases' ‹(WHILE b DO c, t) ⟹ t'›,
        case WhileTrue : _ _ t t₁ t' _ _ _ { -- WhileTrue, WhileTrue
          have : 0 <= sec₆ b, from nat.zero_le (sec₆ b),
          have : 0 ⊢. c, from anti_monotonicity ‹sec₆ b ⊢. c› ‹0 <= sec₆ b›,

          have : s₁ = t₁ [<= l], from ih₁ ‹(c, t) ⟹ t₁› ‹0 ⊢. c› ‹s = t [<= l]›,

          show s' = t' [<= l], from
            ih₂ ‹(WHILE b DO c, t₁) ⟹ t'› (While ‹max 0 (sec₆ b) ⊢. c›) ‹s₁ = t₁ [<= l]›
        },
        case WhileFalse : _ _ t _ {
          have : (sec₆ b <= l) ∨ (sec₆ b > l), from le_or_lt (sec₆ b) l,
          cases' ‹(sec₆ b <= l) ∨ (sec₆ b > l)›,
            case inr : { -- WhileTrue, WhileFalse, (sec₆ b > l)
              have : max (sec₆ b) (sec₆ b) ⊢. c, by simpa[max_self] using ‹sec₆ b ⊢. c›,

              have : s = s₁ [< sec₆ b], from confinement ‹(c, s) ⟹ s₁› ‹sec₆ b ⊢. c›,
              have : s₁ = s' [< sec₆ b], from
                confinement ‹(WHILE b DO c, s₁) ⟹ s'› (While ‹max (sec₆ b) (sec₆ b) ⊢. c›),

              have : s = s₁ [<= l], from restrict ‹s = s₁ [< sec₆ b]› ‹sec₆ b > l›,
              have : s₁ = s' [<= l], from restrict ‹s₁ = s' [< sec₆ b]› ‹sec₆ b > l›,

              show s' = t [<= l], from
                symm (trans (symm ‹s = t [<= l]›) (trans ‹s = s₁ [<= l]› ‹s₁ = s' [<= l]›))
            },
            case inl : { -- WhileTrue, WhileFalse, (sec₆ b <= l)
              rw[noninterference_bexp ‹s = t [<= l]› ‹sec₆ b ≤ l›] at *,
              contradiction
            }
        }
    },
    case WhileFalse : _ _ s _ {
      cases' ‹0 ⊢. WHILE b DO c›,

      have : sec₆ b ⊢. c, by simpa[nat.zero_max] using ‹max 0 (sec₆ b) ⊢. c›,

      cases' ‹(WHILE b DO c, t) ⟹ t'›,
        case WhileFalse : _ _ t _ { -- WhileFalse, WhileFalse
          show s = t [<= l], by assumption
        },
        case WhileTrue : _ _ t t₁ {
          have : (sec₆ b <= l) ∨ (sec₆ b > l), from le_or_lt (sec₆ b) l,
          cases' ‹(sec₆ b <= l) ∨ (sec₆ b > l)›,
            case inr : { -- WhileFalse, WhileTrue, (sec₆ b > l)
              have : max (sec₆ b) (sec₆ b) ⊢. c, by simpa[max_self] using ‹sec₆ b ⊢. c›,

              have : t = t₁ [< sec₆ b], from confinement ‹(c, t) ⟹ t₁› ‹sec₆ b ⊢. c›,
              have : t₁ = t' [< sec₆ b], from
                confinement ‹(WHILE b DO c, t₁) ⟹ t'› (While ‹max (sec₆ b) (sec₆ b) ⊢. c›),

              have : t = t₁ [<= l], from restrict ‹t = t₁ [< sec₆ b]› ‹sec₆ b > l›,
              have : t₁ = t' [<= l], from restrict ‹t₁ = t' [< sec₆ b]› ‹sec₆ b > l›,

              show s = t' [<= l], from
                trans (trans ‹s = t [<= l]› ‹t = t₁ [<= l]›) ‹t₁ = t' [<= l]›
            },
            case inl : { -- WhileFalse, WhileTrue, (sec₆ b <= l)
              rw[noninterference_bexp ‹s = t [<= l]› ‹sec₆ b ≤ l›] at *,
              contradiction
            }
        }
    }
end