import for_mathlib.category_theory.localization.opposite
import for_mathlib.category_theory.functor_misc
import for_mathlib.category_theory.localization.products

noncomputable theory

namespace category_theory

open category

variables {C : Type*} [category C] {W : morphism_property C}

structure left_calculus_of_fractions.to_sq {X' X Y : C} (s : X ⟶ X') (hs : W s) (f : X ⟶ Y) :=
(obj : C)
(g : X' ⟶ obj)
(s' : Y ⟶ obj)
(hs' : W s')
(fac : f ≫ s' = s ≫ g)

variable (W)

class left_calculus_of_fractions : Prop :=
(id : W.contains_identities)
(comp [] : W.stable_under_composition)
(ex : ∀ ⦃X' X Y : C⦄ (s : X ⟶ X') (hs : W s) (u : X ⟶ Y),
  nonempty (left_calculus_of_fractions.to_sq s hs u))
(ext : ∀ ⦃X' X Y : C⦄ (f₁ f₂ : X ⟶ Y) (s : X' ⟶ X) (hs : W s) (eq : s ≫ f₁ = s ≫ f₂),
  ∃ (Y' : C) (t : Y ⟶ Y') (ht : W t), f₁ ≫ t = f₂ ≫ t)

instance left_calculus_of_fractions.contains_identities
  [h : left_calculus_of_fractions W] : W.contains_identities := h.id

namespace left_calculus_of_fractions

variables (W)

structure roof (X Y : C) :=
(Z : C) (f : X ⟶ Z) (s : Y ⟶ Z) (hs : W s)

variable {W}
def roof_rel ⦃X Y : C⦄ (z₁ z₂ : roof W X Y) : Prop :=
∃ (Z₃ : C) (t₁ : z₁.Z ⟶ Z₃) (t₂ : z₂.Z ⟶ Z₃) (hst : z₁.s ≫ t₁ = z₂.s ≫ t₂)
  (hft : z₁.f ≫ t₁ = z₂.f ≫ t₂), W (z₁.s ≫ t₁)

variables [left_calculus_of_fractions W] (W)

@[simps]
def roof.of_hom {X Y : C} (f : X ⟶ Y) : roof W X Y :=
⟨Y, f, 𝟙 Y, morphism_property.contains_identities.id W Y⟩

@[simps]
def roof.id (X : C) := roof.of_hom W (𝟙 X)

namespace roof_rel

variables {W}

lemma refl {X Y : C} (z : roof W X Y) : roof_rel z z :=
⟨z.Z, 𝟙 _, 𝟙 _, rfl, rfl, by simpa only [comp_id] using z.hs⟩

lemma symm {X Y : C} {z₁ z₂ : roof W X Y} (h : roof_rel z₁ z₂) : roof_rel z₂ z₁ :=
begin
  rcases h with ⟨Z₃, t₁, t₂, hst, hft, ht⟩,
  refine ⟨Z₃, t₂, t₁, hst.symm, hft.symm, by simpa only [← hst] using ht⟩,
end

lemma trans {X Y : C} {z₁ z₂ z₃ : roof W X Y} (h₁₂ : roof_rel z₁ z₂)
  (h₂₃ : roof_rel z₂ z₃) : roof_rel z₁ z₃ :=
begin
  rcases h₁₂ with ⟨Z₄, t₁, t₂, hst, hft, ht⟩,
  rcases h₂₃ with ⟨Z₅, u₂, u₃, hsu, hfu, hu⟩,
  rcases left_calculus_of_fractions.ex (z₁.s ≫ t₁) ht (z₃.s ≫ u₃) with ⟨Z₆, v₄, v₅, hv₅, fac⟩,
  simp only [assoc] at fac,
  have eq : z₂.s ≫ u₂ ≫ v₅ = z₂.s ≫ t₂ ≫ v₄,
  { simpa only [← reassoc_of hsu, reassoc_of hst] using fac, },
  rcases left_calculus_of_fractions.ext _ _ _ z₂.hs eq with ⟨Z₇, w, hw, fac'⟩,
  simp only [assoc] at fac',
  refine ⟨Z₇, t₁ ≫ v₄ ≫ w, u₃ ≫ v₅ ≫ w, _, _, _⟩,
  { rw reassoc_of fac, },
  { rw [reassoc_of hft, ← fac', reassoc_of hfu], },
  { rw [← reassoc_of fac, ← reassoc_of hsu, ← assoc],
    exact left_calculus_of_fractions.comp _ _ _ hu
      (left_calculus_of_fractions.comp _ _ _ hv₅ hw), },
end

end roof_rel

instance is_equiv_roof_rel (X Y : C) :
  is_equiv (roof W X Y) (λ z₁ z₂, roof_rel z₁ z₂) :=
{ refl := roof_rel.refl,
  symm := λ z₁ z₂, roof_rel.symm,
  trans := λ z₁ z₂ z₃, roof_rel.trans, }

variable {W}

def roof.comp₀ {X₁ X₂ X₃ : C} (z₁₂ : roof W X₁ X₂) (z₂₃ : roof W X₂ X₃)
  (sq : to_sq z₁₂.s z₁₂.hs z₂₃.f) :
  roof W X₁ X₃ :=
⟨sq.obj, z₁₂.f ≫ sq.g , z₂₃.s ≫ sq.s', left_calculus_of_fractions.comp _ _ _ z₂₃.hs sq.hs'⟩

lemma roof.comp₀_rel {X₁ X₂ X₃ : C} (z₁₂ : roof W X₁ X₂) (z₂₃ : roof W X₂ X₃)
  (sq sq' : to_sq z₁₂.s z₁₂.hs z₂₃.f) :
  roof_rel (roof.comp₀ z₁₂ z₂₃ sq) (roof.comp₀ z₁₂ z₂₃ sq') :=
begin
  let H := (left_calculus_of_fractions.ex sq.s' sq.hs' sq'.s').some,
  have eq : z₁₂.s ≫ sq.g ≫ H.g = z₁₂.s ≫ sq'.g ≫ H.s',
  { rw [← reassoc_of sq.fac, ← reassoc_of sq'.fac, H.fac], },
  rcases left_calculus_of_fractions.ext _ _ _ (z₁₂.hs) eq with ⟨Y, t, ht, fac⟩,
  refine ⟨Y, H.g ≫ t, H.s' ≫ t, _, _, _⟩,
  { dsimp [roof.comp₀],
    simp only [assoc, reassoc_of H.fac], },
  { dsimp [roof.comp₀],
    simp only [assoc] at ⊢ fac,
    rw ← fac, },
  { dsimp [roof.comp₀],
    simp only [assoc, ← reassoc_of H.fac],
    refine left_calculus_of_fractions.comp _ _ _ z₂₃.hs
      (left_calculus_of_fractions.comp _ _ _ sq'.hs'
        (left_calculus_of_fractions.comp _ _ _ H.hs' ht)), }
end

variable (W)

def hom (X Y : C) := quot ((λ (z₁ z₂ : roof W X Y), roof_rel z₁ z₂))

variable {W}

def roof.comp {X₁ X₂ X₃ : C} (z₁₂ : roof W X₁ X₂) (z₂₃ : roof W X₂ X₃) :
  hom W X₁ X₃ :=
quot.mk _ (roof.comp₀ z₁₂ z₂₃ (left_calculus_of_fractions.ex z₁₂.s z₁₂.hs z₂₃.f).some)

lemma roof.comp_eq {X₁ X₂ X₃ : C} (z₁₂ : roof W X₁ X₂) (z₂₃ : roof W X₂ X₃)
  (sq : to_sq z₁₂.s z₁₂.hs z₂₃.f) :
  roof.comp z₁₂ z₂₃ = quot.mk _ (roof.comp₀ z₁₂ z₂₃ sq) :=
quot.sound (roof.comp₀_rel z₁₂ z₂₃ _ _)

def hom.comp {X₁ X₂ X₃ : C} : hom W X₁ X₂ → hom W X₂ X₃ → hom W X₁ X₃ :=
begin
  refine quot.lift₂ (λ z₁₂ z₂₃, roof.comp z₁₂ z₂₃) (λ z₁₂ z₂₃ z₂₃' h₂₃, _)
    (λ z₁₂ z₁₂' z₂₃ h₁₂, _),
  { dsimp,
    let sq := (left_calculus_of_fractions.ex z₁₂.s z₁₂.hs z₂₃.f).some,
    let sq' := (left_calculus_of_fractions.ex z₁₂.s z₁₂.hs z₂₃'.f).some,
    rw [roof.comp_eq _ _ sq, roof.comp_eq _ _ sq'],
    apply quot.sound,
    rcases h₂₃ with ⟨Y, t, t', hst, hft, ht⟩,
    let H₀ := (left_calculus_of_fractions.ex sq.s' sq.hs' t).some,
    let H₀' := (left_calculus_of_fractions.ex sq'.s' sq'.hs' t').some,
    have h : W (z₂₃.s ≫ sq.s' ≫ H₀.g),
    { rw [← H₀.fac, ← assoc],
      exact left_calculus_of_fractions.comp _ _ _ ht H₀.hs', },
    let H₁ := (left_calculus_of_fractions.ex H₀.s' H₀.hs' H₀'.s').some,
    have eq : z₁₂.s ≫ sq.g ≫ H₀.g ≫ H₁.g = z₁₂.s ≫ sq'.g ≫ H₀'.g ≫ H₁.s',
    { simp only [← reassoc_of sq.fac, ← reassoc_of sq'.fac,← reassoc_of H₀.fac,
        ← reassoc_of H₀'.fac, reassoc_of hft, H₁.fac], },
    rcases left_calculus_of_fractions.ext _ _ _ z₁₂.hs eq with ⟨Z, u, hu, fac⟩,
    simp only [assoc] at fac,
    refine ⟨Z, H₀.g ≫ H₁.g ≫ u, H₀'.g ≫ H₁.s' ≫ u, _, _, _⟩; dsimp [roof.comp₀],
    { simp only [assoc, ← reassoc_of H₀.fac, ← reassoc_of H₀'.fac,
        reassoc_of hst, reassoc_of H₁.fac], },
    { simp only [assoc, fac], },
    { simp only [assoc],
      rw [← reassoc_of H₀.fac, ← reassoc_of H₁.fac, ← assoc],
      refine left_calculus_of_fractions.comp _ _ _ ht
        (left_calculus_of_fractions.comp _ _ _ H₀'.hs'
          (left_calculus_of_fractions.comp _ _ _ H₁.hs' hu)), }, },
  { dsimp,
    let sq := (left_calculus_of_fractions.ex z₁₂.s z₁₂.hs z₂₃.f).some,
    let sq' := (left_calculus_of_fractions.ex z₁₂'.s z₁₂'.hs z₂₃.f).some,
    rw [roof.comp_eq _ _ sq, roof.comp_eq _ _ sq'],
    apply quot.sound,
    rcases h₁₂ with ⟨Y, t, t', hst, hft, ht⟩,
    let H := (left_calculus_of_fractions.ex (z₁₂.s ≫ t) ht (z₂₃.f ≫ sq.s')).some,
    let H' := (left_calculus_of_fractions.ex (z₁₂'.s ≫ t') (by { rw ← hst, exact ht, })
      (z₂₃.f ≫ sq'.s')).some,
    let z : roof W X₁ X₃ := ⟨H.obj, z₁₂.f ≫ t ≫ H.g, z₂₃.s ≫ sq.s' ≫ H.s',
      left_calculus_of_fractions.comp _ _ _ z₂₃.hs
        (left_calculus_of_fractions.comp _ _ _ sq.hs' H.hs')⟩,
    let z' : roof W X₁ X₃ := ⟨H'.obj, z₁₂'.f ≫ t' ≫ H'.g, z₂₃.s ≫ sq'.s' ≫ H'.s',
      left_calculus_of_fractions.comp _ _ _ z₂₃.hs
        (left_calculus_of_fractions.comp _ _ _ sq'.hs' H'.hs')⟩,
    refine trans _ (trans (_ : roof_rel z z') (symm _)),
    { have eq : z₁₂.s ≫ sq.g ≫ H.s' = z₁₂.s ≫ t ≫ H.g,
      { have h := H.fac,
        simp only [assoc] at h,
        rw [← h, reassoc_of sq.fac], },
      rcases left_calculus_of_fractions.ext _ _ _ z₁₂.hs eq with ⟨Z, u, hu, fac⟩,
      simp only [assoc] at fac,
      refine ⟨Z, H.s' ≫ u, u, _,_, _⟩; dsimp [roof.comp₀],
      { simp only [assoc, comp_id], },
      { simp only [assoc, comp_id, fac], },
      { simp only [assoc],
        refine left_calculus_of_fractions.comp _ _ _ z₂₃.hs
          (left_calculus_of_fractions.comp _ _ _ sq.hs'
          (left_calculus_of_fractions.comp _ _ _ H.hs' hu)), }, },
    { let T := (left_calculus_of_fractions.ex (sq.s' ≫ H.s')
        (left_calculus_of_fractions.comp _ _ _ sq.hs' H.hs') (sq'.s' ≫ H'.s')).some,
      have Tfac := T.fac,
      have fac := H.fac,
      have fac' := H'.fac,
      simp only [assoc] at Tfac fac fac',
      have eq : z₁₂.s ≫ t ≫ H.g ≫ T.g = z₁₂.s ≫ t ≫ H'.g ≫ T.s',
      { simp only [reassoc_of hst, ← reassoc_of fac', Tfac, reassoc_of fac], },
      rcases left_calculus_of_fractions.ext _ _ _ z₁₂.hs eq with ⟨Z, u, hu, fac''⟩,
      simp only [assoc] at fac'',
      refine ⟨Z, T.g ≫ u, T.s' ≫ u, _, _, _⟩; dsimp [z, z'],
      { simp only [assoc, reassoc_of Tfac], },
      { rw [assoc, assoc, assoc, assoc, fac'', reassoc_of hft], },
      { simp only [assoc, ← reassoc_of Tfac],
        exact left_calculus_of_fractions.comp _ _ _ z₂₃.hs
          (left_calculus_of_fractions.comp _ _ _ sq'.hs'
          (left_calculus_of_fractions.comp _ _ _ H'.hs'
          (left_calculus_of_fractions.comp _ _ _ T.hs' hu))), }, },
    { have eq : z₁₂'.s ≫ sq'.g ≫ H'.s' = z₁₂'.s ≫ t' ≫ H'.g,
      { have h := H'.fac,
        simp only [assoc] at h,
        rw [← h, reassoc_of sq'.fac], },
      rcases left_calculus_of_fractions.ext _ _ _ z₁₂'.hs eq with ⟨Z, u, hu, fac⟩,
      simp only [assoc] at fac,
      refine ⟨Z, H'.s' ≫ u, u, _,_, _⟩; dsimp [roof.comp₀],
      { simp only [assoc, comp_id], },
      { simp only [assoc, comp_id, fac], },
      { simp only [assoc],
        refine left_calculus_of_fractions.comp _ _ _ z₂₃.hs
          (left_calculus_of_fractions.comp _ _ _ sq'.hs'
          (left_calculus_of_fractions.comp _ _ _ H'.hs' hu)), }, }, },
end

lemma hom.comp_eq {X₁ X₂ X₃ : C} (z₁₂ : roof W X₁ X₂) (z₂₃ : roof W X₂ X₃)
  (sq : to_sq z₁₂.s z₁₂.hs z₂₃.f) : hom.comp (quot.mk _ z₁₂) (quot.mk _ z₂₃) =
  quot.mk _ (roof.comp₀ z₁₂ z₂₃ sq) :=
begin
  let sq' := (left_calculus_of_fractions.ex z₁₂.s z₁₂.hs z₂₃.f).some,
  have eq : (quot.mk _ (z₁₂.comp₀ z₂₃ sq) : hom W _ _) = quot.mk _ (z₁₂.comp₀ z₂₃ sq'),
  { rw [← roof.comp_eq, ← roof.comp_eq], },
  simpa only [eq],
end

include W

variable (W)

structure localization :=
(obj : C)

instance : category (localization W) :=
{ hom := λ X Y, hom W X.obj Y.obj,
  id := λ X, quot.mk _ (roof.id W X.obj),
  comp := λ X₁ X₂ X₃, hom.comp,
  id_comp' := λ X Y f, begin
    cases surjective_quot_mk _ f with g hg,
    subst hg,
    dsimp [hom.comp],
    let sq : to_sq (𝟙 X.obj) (morphism_property.contains_identities.id W X.obj) g.f :=
      ⟨g.Z, g.f, 𝟙 g.Z, morphism_property.contains_identities.id W g.Z, by rw [id_comp, comp_id]⟩,
    rw roof.comp_eq (roof.id W X.obj) g sq,
    congr' 1,
    dsimp [roof.comp₀],
    cases g,
    tidy,
  end,
  comp_id' := λ X Y f, begin
    cases surjective_quot_mk _ f with g hg,
    subst hg,
    dsimp [hom.comp],
    let sq : to_sq g.s g.hs (𝟙 Y.obj) := ⟨g.Z, 𝟙 g.Z, g.s, g.hs, by rw [id_comp, comp_id]⟩,
    rw roof.comp_eq g (roof.id W Y.obj) sq,
    congr' 1,
    dsimp [roof.comp₀],
    cases g,
    tidy,
  end,
  assoc' := λ X₁ X₂ X₃ X₄ f₁₂ f₂₃ f₃₄, begin
    cases surjective_quot_mk _ f₁₂ with z₁₂ h₁₂,
    cases surjective_quot_mk _ f₂₃ with z₂₃ h₂₃,
    cases surjective_quot_mk _ f₃₄ with z₃₄ h₃₄,
    let sq₁₃ := (left_calculus_of_fractions.ex z₁₂.s z₁₂.hs z₂₃.f).some,
    let sq₂₄ := (left_calculus_of_fractions.ex z₂₃.s z₂₃.hs z₃₄.f).some,
    dsimp,
    let H := (left_calculus_of_fractions.ex sq₁₃.s' sq₁₃.hs' sq₂₄.g).some,
    let sq : to_sq (z₁₂.comp₀ z₂₃ sq₁₃).s (z₁₂.comp₀ z₂₃ sq₁₃).hs z₃₄.f := begin
      refine ⟨H.obj, H.g, sq₂₄.s' ≫ H.s', left_calculus_of_fractions.comp _ _ _ sq₂₄.hs' H.hs', _⟩,
      dsimp [roof.comp₀],
      rw [assoc, ← H.fac, reassoc_of sq₂₄.fac],
    end,
    let sq' : to_sq z₁₂.s z₁₂.hs (z₂₃.comp₀ z₃₄ sq₂₄).f := begin
      refine ⟨H.obj, sq₁₃.g ≫ H.g, H.s', H.hs', _⟩,
      dsimp [roof.comp₀],
      rw [assoc, H.fac, reassoc_of sq₁₃.fac],
    end,
    simp only [← h₁₂, ← h₂₃, ← h₃₄],
    rw [hom.comp_eq z₁₂ z₂₃ sq₁₃, hom.comp_eq z₂₃ z₃₄ sq₂₄,
      hom.comp_eq (z₁₂.comp₀ z₂₃ sq₁₃) z₃₄ sq, hom.comp_eq z₁₂ (z₂₃.comp₀ z₃₄ sq₂₄) sq'],
    congr' 1,
    dsimp [roof.comp₀],
    tidy,
  end, }

variable {W}

def roof.hom {X Y : localization W} (z : roof W X.obj Y.obj) : X ⟶ Y := quot.mk _ z

def map_roof {D : Type*} [category D] (F : C ⥤ D) (hF : W.is_inverted_by F)
  {X Y : C} (z : roof W X Y) : F.obj X ⟶ F.obj Y :=
F.map z.f ≫ by { haveI := hF z.s z.hs, exact inv (F.map z.s), }

namespace localization

lemma comp_eq {X₁ X₂ X₃ : localization W} (z₁₂ : roof W X₁.obj X₂.obj) (z₂₃ : roof W X₂.obj X₃.obj)
  (sq : to_sq z₁₂.s z₁₂.hs z₂₃.f) : z₁₂.hom ≫ z₂₃.hom = (roof.comp₀ z₁₂ z₂₃ sq).hom :=
hom.comp_eq z₁₂ z₂₃ sq

variable (W)

def hom_obj {X Y : C} (f : X ⟶ Y) :
  (⟨X⟩ : localization W).obj ⟶ (⟨Y⟩ : localization W).obj := f

@[simps]
def Q : C ⥤ localization W :=
{ obj := λ X, ⟨X⟩,
  map := λ X Y f, (roof.of_hom W (hom_obj W f)).hom,
  map_comp' := λ X₁ X₂ X₃ f g, begin
    dsimp,
    rw localization.comp_eq (roof.of_hom W (hom_obj W f)) (roof.of_hom W (hom_obj W g))
      ⟨X₃, g, 𝟙 X₃, morphism_property.contains_identities.id W X₃, by tidy⟩,
    dsimp [roof.of_hom, roof.comp₀],
    congr' 1,
    tidy,
  end, }

variable {W}

@[simps]
def roof.inv {X Y : C} (s : X ⟶ Y) (hs : W s) :
  roof W (⟨Y⟩ : localization W).obj (⟨X⟩ : localization W).obj := ⟨Y, 𝟙 Y, s, hs⟩

def inv_Q_map {X Y : C} (s : X ⟶ Y) (hs : W s) : (Q W).obj Y ⟶ (Q W).obj X :=
roof.hom (roof.inv s hs)

lemma comp_inv_Q_map {X Y : C} (s : X ⟶ Y) (hs : W s) :
  (Q W).map s ≫ inv_Q_map s hs = 𝟙 _ :=
begin
  dsimp only [Q, inv_Q_map],
  rw localization.comp_eq (roof.of_hom W (hom_obj W s)) (roof.inv s hs)
    ⟨Y, 𝟙 Y, 𝟙 Y, morphism_property.contains_identities.id W Y, rfl⟩,
  dsimp [roof.comp₀],
  exact quot.sound ⟨Y, 𝟙 Y, s, by tidy, by tidy, by tidy⟩,
end

lemma inv_Q_map_comp {X Y : C} (s : X ⟶ Y) (hs : W s) :
   inv_Q_map s hs ≫ (Q W).map s = 𝟙 _ :=
begin
  dsimp [Q, inv_Q_map],
  rw localization.comp_eq (roof.inv s hs) (roof.of_hom W (hom_obj W s))
    ⟨Y, 𝟙 Y, 𝟙 Y, morphism_property.contains_identities.id W Y, rfl⟩,
  dsimp [roof.comp₀],
  exact quot.sound ⟨Y, 𝟙 Y, 𝟙 Y, by tidy, by tidy,
    by { dsimp, simp only [comp_id], exact morphism_property.contains_identities.id W _, }⟩,
end

variable (W)

lemma Q_inverts_W : W.is_inverted_by (Q W) :=
λ X Y s hs, ⟨⟨inv_Q_map s hs, comp_inv_Q_map s hs, inv_Q_map_comp s hs⟩⟩

lemma inv_Q_map_eq {X Y : C} (s : X ⟶ Y) (hs : W s) :
  inv_Q_map s hs = (by { haveI := Q_inverts_W W s hs, exact inv ((Q W).map s), }) :=
begin
  haveI := Q_inverts_W W s hs,
  simp only [← cancel_mono ((Q W).map s), is_iso.inv_hom_id, inv_Q_map_comp],
end

instance {X Y : C} (s : X ⟶ Y) (hs : W s) : is_iso (inv_Q_map s hs) :=
by { rw inv_Q_map_eq, apply_instance, }

variables {W}

@[simp]
lemma id_eq (X : localization W) : 𝟙 X = quot.mk _ (roof.id W X.obj) := rfl

instance {X Y : C} (z : roof W X Y) : is_iso ((Q W).map z.s) :=
Q_inverts_W W z.s z.hs

lemma map_roof_eq {X Y : C} (z : roof W X Y) :
  map_roof (localization.Q W) (Q_inverts_W W) z = quot.mk _ z :=
begin
  dsimp only [map_roof],
  rw ← inv_Q_map_eq W z.s z.hs,
  dsimp only [Q, inv_Q_map],
  rw comp_eq (roof.of_hom W (hom_obj W z.f)) (roof.inv z.s z.hs)
    ⟨z.Z, 𝟙 _, 𝟙 _, morphism_property.contains_identities.id W _, rfl⟩,
  dsimp [roof.of_hom, roof.comp₀, hom_obj, roof.hom],
  simp only [comp_id],
  cases z,
  refl,
end

variable (W)
lemma hom_fac {X Y : C} (f : (Q W).obj X ⟶ (Q W).obj Y) :
  ∃ (z : roof W X Y), f = map_roof (Q W) (Q_inverts_W W) z :=
begin
  cases surjective_quot_mk _ f with z hz,
  subst hz,
  exact ⟨z, (map_roof_eq z).symm⟩,
end

variable {W}

def lift {D : Type*} [category D] (F : C ⥤ D) (hF : W.is_inverted_by F) :
  localization W ⥤ D :=
{ obj := λ X, F.obj X.obj,
  map := λ X Y, quot.lift (λ (f : roof W X.obj Y.obj),
    by { haveI := hF f.s f.hs, exact F.map f.f ≫ inv (F.map f.s)})
    (λ z z' (h : roof_rel z z'), begin
      dsimp,
      rcases h with ⟨Y, t₁, t₂, hst, hft, ht⟩,
      haveI := hF _ ht,
      rw [← cancel_mono (F.map (z.s ≫ t₁)), assoc, assoc],
      nth_rewrite 0 F.map_comp,
      rw [is_iso.inv_hom_id_assoc, hst, F.map_comp, is_iso.inv_hom_id_assoc,
        ← F.map_comp z'.f, ← hft, F.map_comp],
    end),
  map_comp' := λ X₁ X₂ X₃ f₁ f₂, begin
    dsimp,
    cases surjective_quot_mk _ f₁ with g₁ h₁,
    cases surjective_quot_mk _ f₂ with g₂ h₂,
    substs h₁ h₂,
    let sq := (left_calculus_of_fractions.ex g₁.s g₁.hs g₂.f).some,
    erw comp_eq g₁ g₂ sq,
    dsimp [roof.comp₀, roof.hom],
    simp only [functor.map_comp, assoc],
    haveI := hF g₁.s g₁.hs,
    haveI := hF g₂.s g₂.hs,
    haveI := hF sq.s' sq.hs',
    rw is_iso.inv_comp,
    congr' 1,
    simp only [← cancel_mono (F.map g₂.s), ← cancel_mono (F.map sq.s'), ← cancel_epi (F.map g₁.s),
      assoc, is_iso.inv_hom_id, comp_id, is_iso.hom_inv_id_assoc, ← F.map_comp, sq.fac],
  end, }

lemma fac {D : Type*} [category D] (F : C ⥤ D) (hF : W.is_inverted_by F) :
  Q W ⋙ lift F hF = F :=
functor.ext (λ X, rfl) (λ X Y f, begin
  dsimp [lift, roof.hom, hom_obj],
  simp only [functor.map_id, is_iso.inv_id, id_comp],
end)

lemma uniq {D : Type*} [category D] (F₁ F₂ : localization W ⥤ D) (h : Q W ⋙ F₁ = Q W ⋙ F₂) :
  F₁ = F₂ :=
begin
  have eq : ∀ (X : localization W), F₁.obj X = F₂.obj X,
  { intro X,
    cases X,
    apply functor.congr_obj h X, },
  apply functor.ext eq,
  intros X Y f,
  cases X,
  cases Y,
  rcases hom_fac W f with ⟨φ, hφ⟩,
  subst f,
  have eq₁ := functor.congr_map_conjugate h φ.f,
  have eq₂ := functor.congr_map_conjugate h φ.s,
  dsimp only [functor.comp_map] at eq₁ eq₂,
  dsimp only [map_roof],
  simpa only [functor.map_comp, functor.map_inv, eq₁, eq₂, assoc, is_iso.inv_comp,
    inv_eq_to_hom, eq_to_hom_trans_assoc, eq_to_hom_refl, id_comp],
end

def universal_property (D : Type*) [category D] :
  localization.strict_universal_property_fixed_target (Q W) W D :=
{ inverts := Q_inverts_W W,
  lift := lift,
  fac := fac,
  uniq := uniq, }

instance Q_is_localization : (Q W).is_localization W :=
functor.is_localization.mk' (Q W) W (universal_property _) (universal_property _)

end localization

lemma map_roof_compatibility {D E : Type*} [category D] [category E]
  (L₁ : C ⥤ D) (hL₁ : W.is_inverted_by L₁) (L₂ : C ⥤ E) (hL₂ : W.is_inverted_by L₂)
  (M : D ⥤ E) (e : L₁ ⋙ M ≅ L₂) {X Y : C} (z : roof W X Y) :
  map_roof L₂ hL₂ z = e.inv.app X ≫ M.map (map_roof L₁ hL₁ z) ≫ e.hom.app Y :=
begin
  dsimp [map_roof],
  simp only [M.map_comp, assoc],
  erw ← e.inv.naturality_assoc,
  congr' 1,
  haveI := hL₂ z.s z.hs,
  simp only [← cancel_mono (L₂.map z.s), is_iso.inv_hom_id, functor.map_inv, assoc,
    ← cancel_epi (e.hom.app z.Z), comp_id, iso.hom_inv_id_app_assoc, is_iso.eq_inv_comp],
  apply e.hom.naturality,
end

lemma map_roof_compatibility_imp {D E : Type*} [category D] [category E]
  (L₁ : C ⥤ D) (hL₁ : W.is_inverted_by L₁) (L₂ : C ⥤ E) (hL₂ : W.is_inverted_by L₂)
  (M : D ⥤ E) (e : L₁ ⋙ M ≅ L₂) {X Y : C} (z z' : roof W X Y)
  (eq : map_roof L₁ hL₁ z = map_roof L₁ hL₁ z') :
  map_roof L₂ hL₂ z = map_roof L₂ hL₂ z' :=
by simp only [map_roof_compatibility L₁ hL₁ L₂ hL₂ M e, eq]

lemma L_map_fac {D : Type*} [category D] (L : C ⥤ D) (W : morphism_property C)
  [left_calculus_of_fractions W] [L.is_localization W] {X Y : C} (f : L.obj X ⟶ L.obj Y) :
  ∃ (z : roof W X Y), f = map_roof L (localization.inverts L W) z :=
begin
  let E := (localization.uniq_equivalence W (localization.Q W) L),
  let e : localization.Q W ⋙ E.functor ≅ L :=
    localization.comp_uniq_equivalence_functor_iso W (localization.Q W) L,
  let f' := e.hom.app X ≫ f ≫ e.inv.app Y,
  cases localization.hom_fac W (E.functor.preimage f') with z hz,
  change E.functor.preimage f' =
    map_roof (localization.Q W) (localization.inverts _ W) z at hz,
  replace hz := congr_arg E.functor.map hz,
  refine ⟨z, _⟩,
  simp only [map_roof_compatibility (localization.Q W) (localization.inverts _ W)
    L (localization.inverts _ W) E.functor e, ← hz, functor.image_preimage, assoc,
    iso.inv_hom_id_app, comp_id, iso.inv_hom_id_app_assoc],
end

lemma L_map_roof_eq_iff {D : Type*} [category D] (L : C ⥤ D) {W : morphism_property C}
  [left_calculus_of_fractions W] [L.is_localization W] {X Y : C} (z₁ z₂ : roof W X Y) :
  map_roof L (localization.inverts L W) z₁ =
    map_roof L (localization.inverts L W) z₂ ↔ roof_rel z₁ z₂ :=
begin
  have eq : map_roof L (localization.inverts _ W) z₁ =
      map_roof L (localization.inverts _ W) z₂ ↔
    map_roof (localization.Q W) (localization.inverts _ W) z₁ =
      map_roof (localization.Q W) (localization.inverts _ W) z₂,
  { split,
    all_goals { exact map_roof_compatibility_imp _ _ _ _ _
      (localization.comp_uniq_equivalence_functor_iso W _ _)  _ _, }, },
  simp only [eq, localization.map_roof_eq],
  split,
  { rw quot.eq,
    clear eq,
    intro h,
    induction h with s₁ s₂ h s s₁ s₂ h' h s₁ s₂ s₃ h'₁ h'₂ h₁ h₂,
    exacts [h, roof_rel.refl _, h.symm, h₁.trans h₂], },
  { exact quot.sound, },
end

lemma L_map_eq_iff {D : Type*} [category D] (L : C ⥤ D) (W : morphism_property C)
  [left_calculus_of_fractions W] [L.is_localization W] {X Y : C} (f₁ f₂ : X ⟶ Y) :
  L.map f₁ = L.map f₂ ↔ ∃ (Z : C) (s : Y ⟶ Z) (hs : W s), f₁ ≫ s = f₂ ≫ s :=
begin
  split,
  { intro h,
    rcases (L_map_roof_eq_iff L
      (roof.mk Y f₁ (𝟙 Y) (morphism_property.contains_identities.id W Y))
      (roof.mk Y f₂ (𝟙 Y) (morphism_property.contains_identities.id W Y))).mp
      (by { dsimp [map_roof], rw h, }) with ⟨Z, t₁, t₂, hst, hft, ht⟩,
    dsimp at t₁ t₂ ht hst hft,
    simp only [id_comp] at ht hst,
    refine ⟨Z, t₁, ht, by rw [hft, hst]⟩, },
  { rintro ⟨Z, s, hs, eq⟩,
    haveI := localization.inverts L W s hs,
    simp only [← cancel_mono (L.map s), ← L.map_comp, eq], },
end

section

variables {D : Type*} [category D] (L : C ⥤ D) (W' : morphism_property C)
  [left_calculus_of_fractions W'] [L.is_localization W']
omit W
include L W'

lemma exists_lift_arrow (f : arrow D) :
  ∃ (g : arrow C), nonempty (f ≅ L.map_arrow.obj g) :=
begin
  haveI : ess_surj L := localization.ess_surj L W',
  let e₁ := L.obj_obj_preimage_iso _,
  let e₂ := L.obj_obj_preimage_iso _,
  let f' := e₁.hom ≫ f.hom ≫ e₂.inv,
  rcases L_map_fac L W' f' with ⟨z, hz⟩,
  refine ⟨arrow.mk z.f, nonempty.intro _⟩,
  haveI := localization.inverts L W' z.s z.hs,
  refine arrow.iso_mk e₁.symm (e₂.symm ≪≫ as_iso (L.map z.s)) _,
  dsimp [map_roof] at hz ⊢,
  simp only [← cancel_mono (inv (L.map z.s)), assoc, ← hz, is_iso.hom_inv_id, comp_id,
    ← cancel_epi e₁.hom, e₁.hom_inv_id_assoc],
end

def lift_map₁ {X Y : D} (f : X ⟶ Y) : C := (exists_lift_arrow L W' (arrow.mk f)).some.left
def lift_map₂ {X Y : D} (f : X ⟶ Y) : C := (exists_lift_arrow L W' (arrow.mk f)).some.right
def lift_map {X Y : D} (f : X ⟶ Y) : lift_map₁ L W' f ⟶ lift_map₂ L W' f :=
(exists_lift_arrow L W' (arrow.mk f)).some.hom
def map_lift_map_iso {X Y : D} (f : X ⟶ Y) :
  arrow.mk f ≅ arrow.mk (L.map (lift_map L W' f)) :=
(exists_lift_arrow L W' (arrow.mk f)).some_spec.some
def lift_map_iso₁ {X Y : D} (f : X ⟶ Y) : X ≅ L.obj (lift_map₁ L W' f) :=
arrow.left_func.map_iso (map_lift_map_iso L W' f)
def lift_map_iso₂ {X Y : D} (f : X ⟶ Y) : Y ≅ L.obj (lift_map₂ L W' f) :=
arrow.right_func.map_iso (map_lift_map_iso L W' f)

lemma lift_map_fac {X Y : D} (f : X ⟶ Y) : f ≫ (lift_map_iso₂ L W' f).hom =
  (lift_map_iso₁ L W' f).hom ≫ L.map (lift_map L W' f) :=
(map_lift_map_iso L W' f).hom.w.symm

end

end left_calculus_of_fractions

variable {W}

structure right_calculus_of_fractions.to_sq {X Y Y' : C} (s : Y' ⟶ Y) (hs : W s) (f : X ⟶ Y) :=
(obj : C)
(g : obj ⟶ Y')
(s' : obj ⟶ X)
(hs' : W s')
(fac : s' ≫ f = g ≫ s)

variable (W)

class right_calculus_of_fractions : Prop :=
(id : W.contains_identities)
(comp : W.stable_under_composition)
(ex : ∀ ⦃X Y Y' : C⦄ (s : Y' ⟶ Y) (hs : W s) (u : X ⟶ Y),
  nonempty (right_calculus_of_fractions.to_sq s hs u))
(ext : ∀ ⦃X Y Y' : C⦄ (f₁ f₂ : X ⟶ Y) (s : Y ⟶ Y') (hs : W s) (eq : f₁ ≫ s = f₂ ≫ s),
  ∃ (X' : C) (t : X' ⟶ X) (ht : W t), t ≫ f₁ = t ≫ f₂)

instance right_calculus_of_fractions.contains_identities
  [h : right_calculus_of_fractions W] : W.contains_identities := h.id

variable {W}

def left_calculus_of_fractions.op
  (h : left_calculus_of_fractions W) : right_calculus_of_fractions W.op :=
{ id := h.id.op,
  comp := h.comp.op,
  ex := λ X Y Y' s hs u, begin
    let sq := (h.ex s.unop hs u.unop).some,
    exact nonempty.intro ⟨opposite.op sq.obj, sq.g.op, sq.s'.op, sq.hs',
      quiver.hom.unop_inj sq.fac⟩,
  end,
  ext := λ X Y Y' f₁ f₂ s hs eq, begin
    rcases h.ext f₁.unop f₂.unop s.unop hs (by simp only [← unop_comp, eq])
      with ⟨X', t, ht, fac⟩,
    exact ⟨opposite.op X', t.op, ht, quiver.hom.unop_inj fac⟩,
  end, }

def left_calculus_of_fractions.unop {W : morphism_property Cᵒᵖ}
  (h : left_calculus_of_fractions W) :
  right_calculus_of_fractions W.unop :=
{ id := h.id.unop,
  comp := h.comp.unop,
  ex := λ X Y Y' s hs u, begin
    let sq := (h.ex s.op hs u.op).some,
    exact nonempty.intro ⟨opposite.unop sq.obj, sq.g.unop, sq.s'.unop, sq.hs',
      quiver.hom.op_inj sq.fac⟩,
  end,
  ext := λ X Y Y' f₁ f₂ s hs eq, begin
    rcases h.ext f₁.op f₂.op s.op hs (by simp only [← op_comp, eq])
      with ⟨X', t, ht, fac⟩,
    exact ⟨opposite.unop X', t.unop, ht, quiver.hom.op_inj fac⟩,
  end, }

def right_calculus_of_fractions.op
  (h : right_calculus_of_fractions W) : left_calculus_of_fractions W.op :=
{ id := h.id.op,
  comp := h.comp.op,
  ex := λ X' X Y s hs u, begin
    let sq := (h.ex s.unop hs u.unop).some,
    exact nonempty.intro ⟨opposite.op sq.obj, sq.g.op, sq.s'.op, sq.hs',
      quiver.hom.unop_inj sq.fac⟩,
  end,
  ext := λ X' X Y f₁ f₂ s hs eq, begin
    have pif := h.ext f₁.unop f₂.unop s.unop hs (by simp only [← unop_comp, eq]),
    rcases h.ext f₁.unop f₂.unop s.unop hs (by simp only [← unop_comp, eq])
      with ⟨Y', t, ht, fac⟩,
    exact ⟨opposite.op Y', t.op, ht, quiver.hom.unop_inj fac⟩,
  end, }

def right_calculus_of_fractions.unop {W : morphism_property Cᵒᵖ}
  (h : right_calculus_of_fractions W) :
  left_calculus_of_fractions W.unop :=
{ id := h.id.unop,
  comp := h.comp.unop,
  ex := λ X' X Y s hs u, begin
    let sq := (h.ex s.op hs u.op).some,
    exact nonempty.intro ⟨opposite.unop sq.obj, sq.g.unop, sq.s'.unop, sq.hs',
      quiver.hom.op_inj sq.fac⟩,
  end,
  ext := λ X' X Y f₁ f₂ s hs eq, begin
    have pif := h.ext f₁.op f₂.op s.op hs (by simp only [← op_comp, eq]),
    rcases h.ext f₁.op f₂.op s.op hs (by simp only [← op_comp, eq])
      with ⟨Y', t, ht, fac⟩,
    exact ⟨opposite.unop Y', t.unop, ht, quiver.hom.op_inj fac⟩,
  end, }

instance [h : right_calculus_of_fractions W] :
  left_calculus_of_fractions W.op := right_calculus_of_fractions.op h

instance [h : left_calculus_of_fractions W] :
  right_calculus_of_fractions W.op := left_calculus_of_fractions.op h

namespace right_calculus_of_fractions

variables (W)

structure roof (X Y : C) :=
(Z : C) (s : Z ⟶ X) (f : Z ⟶ Y) (hs : W s)

variable {W}

def roof.op {X Y : C} (z : roof W X Y) :
  left_calculus_of_fractions.roof W.op (opposite.op Y) (opposite.op X) :=
⟨opposite.op z.Z, z.f.op, z.s.op, z.hs⟩

def roof_rel ⦃X Y : C⦄ (z₁ z₂ : roof W X Y) : Prop :=
∃ (Z₃ : C) (t₁ : Z₃ ⟶ z₁.Z) (t₂ : Z₃ ⟶ z₂.Z) (hts : t₁ ≫ z₁.s = t₂ ≫ z₂.s)
  (htf : t₁ ≫ z₁.f = t₂ ≫ z₂.f), W (t₁ ≫ z₁.s)

lemma roof_rel.iff_op {X Y : C} (z₁ z₂ : roof W X Y) :
  roof_rel z₁ z₂ ↔ left_calculus_of_fractions.roof_rel z₁.op z₂.op :=
begin
  split,
  { intro h,
    rcases h with ⟨Z₃, t₁, t₂, hts, htf, ht⟩,
    exact ⟨opposite.op Z₃, t₁.op, t₂.op, quiver.hom.unop_inj hts, quiver.hom.unop_inj htf, ht⟩, },
  { intro h,
    rcases h with ⟨Z₃, t₁, t₂, hst, hft, ht⟩,
    refine ⟨opposite.unop Z₃, t₁.unop, t₂.unop, quiver.hom.op_inj hst, quiver.hom.op_inj hft, ht⟩, },
end

variables (W) [right_calculus_of_fractions W]

@[simps]
def roof.of_hom {X Y : C} (f : X ⟶ Y) : roof W X Y :=
⟨X, 𝟙 X, f, morphism_property.contains_identities.id W X⟩

@[simps]
def roof.id (X : C) := roof.of_hom W (𝟙 X)

namespace roof_rel

variables {W}

lemma refl {X Y : C} (z : roof W X Y) : roof_rel z z :=
by { rw roof_rel.iff_op, apply left_calculus_of_fractions.roof_rel.refl, }

lemma symm {X Y : C} {z₁ z₂ : roof W X Y} (h : roof_rel z₁ z₂) : roof_rel z₂ z₁ :=
by { rw roof_rel.iff_op at h ⊢, exact h.symm, }

lemma trans {X Y : C} {z₁ z₂ z₃ : roof W X Y} (h₁₂ : roof_rel z₁ z₂)
  (h₂₃ : roof_rel z₂ z₃) : roof_rel z₁ z₃ :=
by { rw roof_rel.iff_op at h₁₂ h₂₃ ⊢, exact h₁₂.trans h₂₃, }

end roof_rel

instance is_equiv_roof_rel (X Y : C) :
  is_equiv (roof W X Y) (λ z₁ z₂, roof_rel z₁ z₂) :=
{ refl := roof_rel.refl,
  symm := λ z₁ z₂, roof_rel.symm,
  trans := λ z₁ z₂ z₃, roof_rel.trans, }

end right_calculus_of_fractions

namespace left_calculus_of_fractions

variables {W} [morphism_property.contains_identities W] [right_calculus_of_fractions W]

def roof.unop {X Y : C} (z : roof W.op (opposite.op X) (opposite.op Y)) :
  right_calculus_of_fractions.roof W Y X :=
⟨opposite.unop z.Z, z.s.unop, z.f.unop, z.hs⟩

end left_calculus_of_fractions

namespace right_calculus_of_fractions

variables {W} [morphism_property.contains_identities W] [right_calculus_of_fractions W]

def map_roof {D : Type*} [category D] (F : C ⥤ D) (hF : W.is_inverted_by F)
  {X Y : C} (z : roof W X Y) : F.obj X ⟶ F.obj Y :=
by { haveI := hF z.s z.hs, exact inv (F.map z.s), } ≫ F.map z.f

lemma map_roof_eq_unop_map_roof_op {D : Type*} [category D] (F : C ⥤ D)
  (hF : W.is_inverted_by F) {X Y : C} (z : roof W X Y) :
  map_roof F hF z = (left_calculus_of_fractions.map_roof F.op hF.op z.op).unop :=
begin
  dsimp [left_calculus_of_fractions.map_roof, map_roof, roof.op],
  simp only [quiver.hom.unop_op, unop_inv],
end

lemma L_map_fac {D : Type*} [category D] (L : C ⥤ D) (W : morphism_property C)
  [right_calculus_of_fractions W]
  [L.is_localization W] {X Y : C} (f : L.obj X ⟶ L.obj Y) :
  ∃ (z : roof W X Y), f = map_roof L (localization.inverts L W) z :=
begin
  let f' : L.op.obj (opposite.op Y) ⟶ L.op.obj (opposite.op X) := f.op,
  rcases left_calculus_of_fractions.L_map_fac L.op W.op f' with ⟨z, hz⟩,
  refine ⟨z.unop, _⟩,
  change f'.unop = _,
  simpa only [hz, map_roof_eq_unop_map_roof_op],
end

lemma L_map_roof_eq_iff {D : Type*} [category D] (L : C ⥤ D) {W : morphism_property C}
  [right_calculus_of_fractions W] [L.is_localization W]
  {X Y : C} (z₁ z₂ : roof W X Y) :
  map_roof L (localization.inverts L W) z₁ =
    map_roof L (localization.inverts L W) z₂ ↔ roof_rel z₁ z₂ :=
begin
  simp only [roof_rel.iff_op, ← left_calculus_of_fractions.L_map_roof_eq_iff L.op z₁.op,
    map_roof_eq_unop_map_roof_op],
  exact ⟨λ h, quiver.hom.unop_inj h, λ h, quiver.hom.op_inj h⟩,
end

lemma L_map_eq_iff {D : Type*} [category D] (L : C ⥤ D) (W : morphism_property C)
  [right_calculus_of_fractions W] [L.is_localization W] {Y Z : C} (f₁ f₂ : Y ⟶ Z) :
  L.map f₁ = L.map f₂ ↔ ∃ (X : C) (s : X ⟶ Y) (hs : W s), s ≫ f₁ = s ≫ f₂ :=
begin
  split,
  { intro h,
    rcases (L_map_roof_eq_iff L
      (roof.mk Y (𝟙 Y) f₁ (morphism_property.contains_identities.id W Y))
      (roof.mk Y (𝟙 Y) f₂ (morphism_property.contains_identities.id W Y))).mp
      (by { dsimp [map_roof], rw h, }) with ⟨Z, t₁, t₂, hts, htf, ht⟩,
    dsimp at t₁ t₂ ht hts htf,
    simp only [comp_id] at ht hts,
    exact ⟨Z, t₁, ht, by rw [htf, hts]⟩, },
  { rintro ⟨Z, s, hs, eq⟩,
    haveI := localization.inverts L W s hs,
    simp only [← cancel_epi (L.map s), ← L.map_comp, eq], },
end

end right_calculus_of_fractions

variable (W)

class morphism_property.is_saturated : Prop :=
(condition' : ∀ ⦃X Y Z T : C⦄ (f : X ⟶ Y) (g : Y ⟶ Z) (h : Z ⟶ T) (hfg : W (f ≫ g))
  (hgh : W (g ≫ h)), W g)

lemma morphism_property.is_saturated.condition [W.is_saturated] {X Y Z T : C}
  (f : X ⟶ Y) (g : Y ⟶ Z) (h : Z ⟶ T) (hfg : W (f ≫ g))
  (hgh : W (g ≫ h)) : W g :=
morphism_property.is_saturated.condition' f g h hfg hgh

namespace localization

lemma is_iso_map_iff_of_calculus_of_fractions {D : Type*} [category D] (L : C ⥤ D)
  (W : morphism_property C) [L.is_localization W] [W.is_saturated]
  [left_calculus_of_fractions W] [right_calculus_of_fractions W] {X Y : C} (f : X ⟶ Y) :
  is_iso (L.map f) ↔ W f :=
begin
  refine ⟨_ ,λ hf, localization.inverts L W f hf⟩,
  introI,
  rcases left_calculus_of_fractions.L_map_fac L W (inv (L.map f)) with ⟨z₁, h₁⟩,
  rcases right_calculus_of_fractions.L_map_fac L W (inv (L.map f)) with ⟨z₂, h₂⟩,
  dsimp [left_calculus_of_fractions.map_roof] at h₁,
  dsimp [right_calculus_of_fractions.map_roof] at h₂,
  rcases (left_calculus_of_fractions.L_map_roof_eq_iff L
    (left_calculus_of_fractions.roof.mk _ (f ≫ z₁.f) z₁.s z₁.hs)
    (left_calculus_of_fractions.roof.id W X)).mp begin
      dsimp [left_calculus_of_fractions.map_roof],
      simp only [L.map_comp, assoc, ← h₁, is_iso.hom_inv_id],
    end with ⟨Z, t₁, t₁', hst, hft, H₁⟩,
  rcases (right_calculus_of_fractions.L_map_roof_eq_iff L
    (right_calculus_of_fractions.roof.mk _ z₂.s (z₂.f ≫ f) z₂.hs)
    (right_calculus_of_fractions.roof.id W Y)).mp begin
      dsimp [right_calculus_of_fractions.map_roof],
      simp only [L.map_comp, assoc, ← reassoc_of h₂, is_iso.inv_hom_id],
    end with ⟨Z', t₂, t₂', hts, htf, H₂⟩,
  dsimp at t₁ t₁' hst hft H₁ t₂ t₂' hts htf H₂,
  simp only [assoc, id_comp, comp_id] at hst hft hts htf,
  rw ← hft at hst,
  rw ← htf at hts,
  exact morphism_property.is_saturated.condition W (t₂ ≫ z₂.f)
    f (z₁.f ≫ t₁) (by simpa only [assoc, ← hts] using H₂)
    (by simpa only [← hst] using H₁),
end

end localization

end category_theory


/-
import condensed.adjunctions
import category_theory.adjunction.evaluation

open category_theory
open category_theory.grothendieck_topology
open opposite

universe u

section for_mathlib

lemma AddCommGroup.mono_iff_injective {X Y : AddCommGroup} (f : X ⟶ Y) :
  mono f ↔ function.injective f := sorry

instance {α : Type u} : limits.has_coproducts_of_shape α Ab.{u+1} := sorry

variables {C : Type (u+1)} [category.{u} C] (J : grothendieck_topology C)
  (F : Cᵒᵖ ⥤ Ab.{u+1}) (G : Sheaf J Ab.{u+1}) (η : F ⟶ G.val)

-- TODO: This theorem may need additional assumptions on `J`.
theorem sheafify_lift_mono_iff :
  mono (sheafify_lift J η G.cond) ↔
  ∀ (B : C) (t : F.obj (op B)), η.app (op B) t = 0 →
  (∃ W : (J.cover B), ∀ f : W.arrow, F.map f.f.op t = 0) :=
begin
  rw nat_trans.mono_iff_app_mono,
  split,
  { intros h B t ht,
    replace h : ∀ B : C, ((J.sheafify_lift η G.cond).app (op B)).ker = ⊥, sorry,
    specialize h B,
    let t' := (J.to_sheafify F).app (op B) t,
    have : t' ∈ add_monoid_hom.ker ((J.sheafify_lift η _).app (op B)), sorry,
    rw h at this, simp only [add_subgroup.mem_bot] at this,
    sorry },
  { intros h B, tactic.op_induction',
    -- Is this missing?
    suffices : function.injective ((J.sheafify_lift η G.cond).app (op B)), sorry,
    rw add_monoid_hom.injective_iff, intros t ht,
    specialize h B, sorry },
end

end for_mathlib

variables (F : Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) (G : Condensed.{u} Ab.{u+1})
variables (η : F ⟶ G.val)

theorem Condensed_Ab_sheafify_lift_mono_iff :
  mono (sheafify_lift _ η G.cond) ↔
  ∀ (B : Profinite.{u}) (t : F.obj (op B)), η.app (op B) t = 0 →
    (∃ (α : Type u) [fintype α] (X : α → Profinite.{u}) (π : Π a : α, X a ⟶ B)
      (surj : ∀ b : B, ∃ (a : α) (x : X a), π a x = b),
      ∀ a : α, F.map (π a).op t = 0) :=
begin
  rw sheafify_lift_mono_iff proetale_topology.{u},
  split,
  { intros h B t ht,
    specialize h B t ht,
    obtain ⟨W,hw⟩ := h,
    rcases W with ⟨W,hW⟩,
    have HW : W ∈ proetale_topology B := hW,
    rcases hW with ⟨W, ⟨α, hα, X, π, surj, rfl⟩, h⟩,
    use [α, hα, X, π, surj], intros a,
    let W' : proetale_topology.cover B := ⟨W,HW⟩,
    let ff : W'.arrow := _,
    swap, { constructor, apply h, use a },
    specialize hw ff, exact hw },
  { rintros h B t ht, specialize h B t ht,
    obtain ⟨α, hα, X, π, surj, hh⟩ := h,
    refine ⟨⟨sieve.generate (presieve.of_arrows X π),_⟩,_⟩,
    constructor, use [α, hα, X, π, surj], exact sieve.le_generate (presieve.of_arrows X π),
    rintros ⟨X,f,⟨W,e1,e2,hhh,rfl⟩⟩,
    dsimp, simp only [F.map_comp, comp_apply],
    obtain ⟨a⟩ := hhh, rw hh,
    rw add_monoid_hom.map_zero }
end
-/


import field_theory.galois
import order.filter.ultrafilter

example (X Y Z : Type*) (f : X → Y) (g : Y → Z) (s : set Z) :
f⁻¹' (g⁻¹' s) = (g ∘ f)⁻¹' s :=
begin
  refl,
end


/-
Copyright (c) 2021 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gabriel Ebner
-/
import Lean
import Std.Util.TermUnsafe
import Std.Tactic.OpenPrivate

/-!
Defines a command wrapper that prints the changes the command makes to the
environment.

```
whatsnew in
theorem foo : 42 = 6 * 7 := rfl
```
-/

open Lean Elab Command

namespace Mathlib.WhatsNew

private def throwUnknownId (id : Name) : CommandElabM Unit :=
  throwError "unknown identifier '{mkConst id}'"

private def levelParamsToMessageData (levelParams : List Name) : MessageData :=
  match levelParams with
  | []    => ""
  | u::us => Id.run <| do
    let mut m := m!".\{{u}"
    for u in us do
      m := m ++ ", " ++ toMessageData u
    return m ++ "}"

private def mkHeader (kind : String) (id : Name) (levelParams : List Name) (type : Expr)
    (safety : DefinitionSafety) : CoreM MessageData := do
  let m : MessageData :=
    match safety with
    | DefinitionSafety.unsafe  => "unsafe "
    | DefinitionSafety.partial => "partial "
    | DefinitionSafety.safe    => ""
  let m := if isProtected (← getEnv) id then m ++ "protected " else m
  let (m, id) := match privateToUserName? id with
    | some id => (m ++ "private ", id)
    | none    => (m, id)
  let m := m ++ kind ++ " " ++ id ++ levelParamsToMessageData levelParams ++ " : " ++ type
  pure m

private def mkHeader' (kind : String) (id : Name) (levelParams : List Name) (type : Expr)
    (isUnsafe : Bool) : CoreM MessageData :=
  mkHeader kind id levelParams type
    (if isUnsafe then DefinitionSafety.unsafe else DefinitionSafety.safe)

private def printDefLike (kind : String) (id : Name) (levelParams : List Name) (type : Expr)
    (value : Expr) (safety := DefinitionSafety.safe) : CoreM MessageData :=
  return (← mkHeader kind id levelParams type safety) ++ " :=" ++ Format.line ++ value

private def printInduct (id : Name) (levelParams : List Name) (_numParams : Nat) (_numIndices : Nat)
    (type : Expr) (ctors : List Name) (isUnsafe : Bool) : CoreM MessageData := do
  let mut m ← mkHeader' "inductive" id levelParams type isUnsafe
  m := m ++ Format.line ++ "constructors:"
  for ctor in ctors do
    let cinfo ← getConstInfo ctor
    m := m ++ Format.line ++ ctor ++ " : " ++ cinfo.type
  pure m

private def printIdCore (id : Name) : ConstantInfo → CoreM MessageData
  | ConstantInfo.axiomInfo { levelParams := us, type := t, isUnsafe := u, .. } =>
    mkHeader' "axiom" id us t u
  | ConstantInfo.defnInfo  { levelParams := us, type := t, value := v, safety := s, .. } =>
    printDefLike "def" id us t v s
  | ConstantInfo.thmInfo  { levelParams := us, type := t, value := v, .. } =>
    printDefLike "theorem" id us t v
  | ConstantInfo.opaqueInfo  { levelParams := us, type := t, isUnsafe := u, .. } =>
    mkHeader' "constant" id us t u
  | ConstantInfo.quotInfo  { levelParams := us, type := t, .. } =>
    mkHeader' "Quotient primitive" id us t false
  | ConstantInfo.ctorInfo { levelParams := us, type := t, isUnsafe := u, .. } =>
    mkHeader' "constructor" id us t u
  | ConstantInfo.recInfo { levelParams := us, type := t, isUnsafe := u, .. } =>
    mkHeader' "recursor" id us t u
  | ConstantInfo.inductInfo
      { levelParams := us, numParams, numIndices, type := t, ctors, isUnsafe := u, .. } =>
    printInduct id us numParams numIndices t ctors u

def diffExtension (old new : Environment)
    (ext : PersistentEnvExtension EnvExtensionEntry EnvExtensionEntry EnvExtensionState) :
    CoreM (Option MessageData) := unsafe do
  let oldSt := ext.toEnvExtension.getState old
  let newSt := ext.toEnvExtension.getState new
  if ptrAddrUnsafe oldSt == ptrAddrUnsafe newSt then return none
  let oldEntries := ext.exportEntriesFn oldSt.state
  let newEntries := ext.exportEntriesFn newSt.state
  pure m!"-- {ext.name} extension: {(newEntries.size - oldEntries.size : Int)} new entries"

def whatsNew (old new : Environment) : CoreM MessageData := do
  let mut diffs := #[]

  for (c, i) in new.constants.map₂.toList do
    unless old.constants.map₂.contains c do
      diffs := diffs.push (← printIdCore c i)

  for ext in ← persistentEnvExtensionsRef.get do
    if let some diff := ← diffExtension old new ext then
      diffs := diffs.push diff

  if diffs.isEmpty then return "no new constants"

  pure $ MessageData.joinSep diffs.toList "\n\n"

/-- `whatsnew in $command` executes the command and then prints the
declarations that were added to the environment. -/
elab "whatsnew" "in" ppLine cmd:command : command => do
  let oldEnv ← getEnv
  try
    elabCommand cmd
  finally
    let newEnv ← getEnv
    logInfo (← liftCoreM <| whatsNew oldEnv newEnv)


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

open list tactic tactic.interactive

meta class elaborable (α : Type) (β : out_param Type) :=
  (elaborate : α → tactic β)

export elaborable (elaborate)

meta instance : elaborable pexpr expr :=
⟨ to_expr ⟩

meta instance elaborable_list {α α'} [elaborable α α'] : elaborable (list α) (list α') :=
⟨ mmap elaborate ⟩

meta def mono_function.elaborate : mono_function ff → tactic mono_function
| (mono_function.non_assoc x y z) :=
mono_function.non_assoc <$> elaborate x
                        <*> elaborate y
                        <*> elaborate z
| (mono_function.assoc x y z) :=
mono_function.assoc <$> elaborate x
                    <*> traverse elaborate y
                    <*> traverse elaborate z
| (mono_function.assoc_comm x y) :=
mono_function.assoc_comm <$> elaborate x
                         <*> elaborate y

meta instance elaborable_mono_function : elaborable (mono_function ff) mono_function :=
⟨ mono_function.elaborate ⟩

meta instance prod_elaborable {α α' β β' : Type} [elaborable α α']  [elaborable β β']
: elaborable (α × β) (α' × β') :=
⟨ λ i, prod.rec_on i (λ x y, prod.mk <$> elaborate x <*> elaborate y) ⟩

meta def parse_mono_function' (l r : pexpr) :=
do l' ← to_expr l,
   r' ← to_expr r,
   parse_ac_mono_function { mono_cfg . } l' r'

run_cmd
do xs ← mmap to_expr [``(1),``(2),``(3)],
   ys ← mmap to_expr [``(1),``(2),``(4)],
   x ← match_prefix { unify := ff } xs ys,
   p ← elaborate ([``(1),``(2)] , [``(3)], [``(4)]),
   guard $ x = p

run_cmd
do xs ← mmap to_expr [``(1),``(2),``(3),``(6),``(7)],
   ys ← mmap to_expr [``(1),``(2),``(4),``(5),``(6),``(7)],
   x ← match_assoc { unify := ff } xs ys,
   p ← elaborate ([``(1), ``(2)], [``(3)], ([``(4), ``(5)], [``(6), ``(7)])),
   guard (x = p)

run_cmd
do x ← to_expr ``(7 + 3 : ℕ) >>= check_ac,
   x ← pp x.2.2.1,
   let y := "(some (is_left_id.left_id, (is_right_id.right_id, 0)))",
   guard (x.to_string = y) <|> fail ("guard: " ++ x.to_string)

meta def test_pp {α} [has_to_tactic_format α] (tag : format) (expected : string) (prog : tactic α) :
  tactic unit :=
do r ← prog,
   pp_r ← pp r,
   guard (pp_r.to_string = expected) <|> fail format!"test_pp: {tag}"

run_cmd
do test_pp "test1"
           "(3 + 6, (4 + 5, ([], has_add.add _ 2 + 1)))"
           (parse_mono_function' ``(1 + 3 + 2 + 6) ``(4 + 2 + 1 + 5)),
   test_pp "test2"
           "([1] ++ [3] ++ [2] ++ [6], ([4] ++ [2] ++ [1] ++ [5], ([], append none _ none)))"
           (parse_mono_function' ``([1] ++ [3] ++ [2] ++ [6]) ``([4] ++ [2] ++ ([1] ++ [5]))),
   test_pp "test3"
           "([3] ++ [2], ([5] ++ [4], ([], append (some [1]) _ (some [2]))))"
           (parse_mono_function' ``([1] ++ [3] ++ [2] ++ [2]) ``([1] ++ [5] ++ ([4] ++ [2])))

def my_id {α : Type*} : α → α := id

@[mono]
lemma test_monotone {α : Type*} [preorder α] : monotone (my_id : α → α) :=
λ x y h, h

example : my_id 0 ≤ my_id 1 :=
begin
  mono,
  simp,
end

@[mono]
lemma test_strict_mono {α : Type*} [preorder α] : strict_mono (my_id : α → α) :=
λ x y h, h

example : my_id 0 < my_id 1 :=
begin
  mono,
  simp,
end


import data.matrix.notation
import o_minimal.sheaf.yoneda

namespace o_minimal

universe u

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

structure map_to (X : Type*) [has_coordinates R X] [definable_rep S X] :=
(obj : Type*)
[has_coordinates : has_coordinates R obj]
[definable_rep : definable_rep S obj]
(to_fun : obj → X)
(is_definable : definable S to_fun)

attribute [instance] map_to.has_coordinates map_to.definable_rep

/-- General (finite) cover of a representable by representables. -/
structure cover (X : Type*) [has_coordinates R X] [definable_rep S X] :=
(n : ℕ)
(map : fin n → map_to S X)
(jointly_surjective : ∀ x, ∃ i l, (map i).to_fun l = x)

variables {S}

-- TODO: Can we avoid the messy pullback construction in `o_minimal.Def` using these?

noncomputable def Def.cover_of_general {K : Def S} (𝓛 : cover S K) : K.cover :=
{ n := 𝓛.n,
  obj := λ i, as_Def S (𝓛.map i).obj,
  map := λ i,
    ⟨(𝓛.map i).to_fun ∘ (equiv_Def S (𝓛.map i).obj).symm,
     (definable_iff_def_fun.mp (𝓛.map i).is_definable).comp def_fun_equiv_Def_symm⟩,
  jointly_surjective := λ k,
    let ⟨i, l, h⟩ := 𝓛.jointly_surjective k in
    ⟨i, (equiv_Def S (𝓛.map i).obj) l, show (𝓛.map i).to_fun _ = k, by simp [h]⟩ }

def cover.pullback {X' X : Type*} [has_coordinates R X'] [definable_rep S X']
  [has_coordinates R X] [definable_rep S X] (𝓛 : cover S X) (f : X' → X) (df : definable S f) :
  cover S X' :=
{ n := 𝓛.n,
  map := λ i,
  { obj := {p : X' × (𝓛.map i).obj | f p.1 = (𝓛.map i).to_fun p.2},
    definable_rep := subtype.definable_rep $ definable_iff_def_set.mpr $ def_set_eq
      ((definable_iff_def_fun.mp df).comp def_fun.fst)
      ((definable_iff_def_fun.mp (𝓛.map i).is_definable).comp def_fun.snd),
    to_fun := prod.fst ∘ subtype.val,
    is_definable := definable.fst.comp definable.subtype.val },
  jointly_surjective := λ x',
    let ⟨i, l, h⟩ := 𝓛.jointly_surjective (f x') in
    ⟨i, ⟨⟨x', l⟩, h.symm⟩, rfl⟩ }

def cover_of_Def {K : Def S} (𝓛 : K.cover) : cover S K :=
{ n := 𝓛.n,
  map := λ i,
  { obj := 𝓛.obj i,
    to_fun := 𝓛.map i,
    is_definable := definable_iff_def_fun.mpr (𝓛.map i).is_definable },
  jointly_surjective := 𝓛.jointly_surjective }

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

lemma definable_cover_of_Def {K : Def S} (f : K → Y) (𝓛 : cover S K)
  (h : ∀ i, definable S (f ∘ (𝓛.map i).to_fun)) : definable S f :=
begin
  rw definable_yoneda,
  let 𝓛' := Def.cover_of_general 𝓛,
  apply definable_sheaf.definable_cover _ 𝓛',
  intro i,
  rw ←definable_yoneda,
  refine (h i).comp _,
  rw definable_iff_def_fun,
  apply def_fun_equiv_Def_symm
end

lemma definable_cover (f : X → Y) (𝓛 : cover S X)
  (h : ∀ i, definable S (f ∘ (𝓛.map i).to_fun)) : definable S f :=
begin
  rw definable_fun,
  intros K φ hφ,
  let 𝓛' := 𝓛.pullback φ (definable_yoneda.mpr hφ),
  rw ←definable_yoneda at ⊢ hφ,
  apply definable_cover_of_Def _ 𝓛',
  intro i,
  change definable S (f ∘ (φ ∘ (𝓛'.map i).to_fun)),
  let ψ : (𝓛'.map i).obj → (𝓛.map i).obj := λ z, z.val.snd,
  have dψ : definable S ψ := definable.snd.comp definable.subtype.val,
  have : φ ∘ (𝓛'.map i).to_fun = (𝓛.map i).to_fun ∘ ψ,
  { ext x,
    exact x.property },
  rw this,
  refine (h i).comp dψ
end

-- Building covers.

def sep_cover (s : set X) (ds : definable S s) : cover S X :=
{ n := 2,
  map :=
  ![{ obj := s,
      definable_rep := subtype.definable_rep ds,
      to_fun := subtype.val,
      is_definable := begin
        -- TODO: lemma
        rw definable_iff_def_fun,
        exact @def_fun_subtype_val R S X _ _ s (definable_iff_def_set.mp ds)
      end },
    { obj := ↥(sᶜ),
      definable_rep := subtype.definable_rep (definable.app definable.compl ds),
      to_fun := subtype.val,
      is_definable := begin
        -- TODO: lemma
        rw definable_iff_def_fun,
        exact @def_fun_subtype_val R S X _ _ _ (def_set.compl $ definable_iff_def_set.mp ds)
      end } ],
  jointly_surjective := begin
    intro x,
    by_cases hx : x ∈ s,
    { refine ⟨0, by exact ⟨x, hx⟩, by exact rfl⟩ },
    { refine ⟨1, by exact ⟨x, hx⟩, by exact rfl⟩ }
  end }

-- TODO: is this true for any sheaf X?
lemma definable_if (f : X → Y) (s : set X) (ds : definable S s)
  (hpos : definable S (f ∘ (subtype.val : s → X)))
  (hneg : definable S (f ∘ (subtype.val : sᶜ → X))) :
  definable S f :=
begin
  apply definable_cover f (sep_cover s ds),
  intro i,
  fin_cases i,
  { exact hpos },
  { exact hneg }
end

end o_minimal


-- Copyright (c) Microsoft Corporation. All rights reserved.
-- Licensed under the MIT license.

import ..smtexpr
import ..bitvector
import ..irsem
import .spec
import .lemmas
import .irstate
import smt2.syntax
import system.io
import init.meta.tactic
import init.meta.interactive

namespace spec

open irsem

def env.added2 (η:freevar.env) (n1 n2:string) (η':freevar.env):=
  (∀ n, n ∉ η → n ≠ n1 ∧ n ≠ n2 → n ∉ η') ∧
  (∀ n, n ∈ η ∨ n = n1 ∨ n = n2 → n ∈ η')

def env.has_only (η:freevar.env) (names:list string) :=
  ∀ name, name ∈ names ↔ name ∈ η

universes u v
@[reducible]
def apply {α:Type u} (f:α → α) : option α → option α
| (some x) := some (f x)
| none := none

lemma apply_none: ∀ {α:Type u} (f:α → α) o,
  apply f o = none ↔ o = none
:= begin
  intros,
  split,
  { intros H, cases o, refl, unfold apply at H, cases H },
  { intros H, rw H }
end

lemma apply_some: ∀ {α:Type u} {f:α → α} {o} {v}
  (H:apply f o = some v), ∃ v', o = some v'
:= begin
  intros,
  cases o with v0,
  { unfold apply at H, cases H },
  { unfold apply at H, apply exists.intro v0, refl }
end

notation η `⟦` s `⟧'` := apply (freevar.env.replace η) s
notation η `⟦` s `⟧'` := apply (freevar.env.replace_valty η) s
notation η `⟦` s `⟧'` := apply (freevar.env.replace_sbv η) s
notation η `⟦` s `⟧'` := apply (freevar.env.replace_sb η) s

-- Induction principles for sbool & sbitvec which are mutually defined
section
@[reducible]
parameters (P:sbool → Prop) (P':Π {sz:size}, sbitvec sz → Prop)
  (Hbtt: P sbool.tt) (Hbff: P sbool.ff) (Hbvar: ∀ s, P (sbool.var s))
  (Hband: ∀ b1 b2, P b1 → P b2 → P (sbool.and b1 b2))
  (Hbor: ∀ b1 b2, P b1 → P b2 → P (sbool.or b1 b2))
  (Hbxor: ∀ b1 b2, P b1 → P b2 → P (sbool.xor b1 b2))
  (Hbeqb: ∀ b1 b2, P b1 → P b2 → P (sbool.eqb b1 b2))
  (Hbneb: ∀ b1 b2, P b1 → P b2 → P (sbool.neb b1 b2))
  (Hbite: ∀ b1 b2 b3, P b1 → P b2 → P b3 → P (sbool.ite b1 b2 b3))
  (Hbnot: ∀ b, P b → P (sbool.not b))
  (Hbeqbv: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P (sbool.eqbv v1 v2))
  (Hbnebv: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P (sbool.nebv v1 v2))
  (Hbsle: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P (sbool.sle v1 v2))
  (Hbslt: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P (sbool.slt v1 v2))
  (Hbule: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P (sbool.ule v1 v2))
  (Hbult: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P (sbool.ult v1 v2))
  (Hvconst: ∀ sz n, P' (sbitvec.const sz n))
  (Hvvar: ∀ sz n, P' (sbitvec.var sz n))
  (Hvadd: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.add v1 v2))
  (Hvsub: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.sub v1 v2))
  (Hvmul: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.mul v1 v2))
  (Hvudiv: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.udiv v1 v2))
  (Hvurem: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.urem v1 v2))
  (Hvsdiv: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.sdiv v1 v2))
  (Hvsrem: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.srem v1 v2))
  (Hvand: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.and v1 v2))
  (Hvor: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.or v1 v2))
  (Hvxor: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.xor v1 v2))
  (Hvshl: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.shl v1 v2))
  (Hvlshr: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.lshr v1 v2))
  (Hvashr: ∀ {sz} (v1 v2:sbitvec sz), P' v1 → P' v2 → P' (sbitvec.ashr v1 v2))
  (Hvzext: ∀ {sz} (v:sbitvec sz) sz', P' v → P' (sbitvec.zext sz' v))
  (Hvsext:∀ {sz} (v:sbitvec sz) sz', P' v → P' (sbitvec.sext sz' v))
  (Hvtrunc: ∀ {sz} (v:sbitvec sz) sz', P' v → P' (sbitvec.trunc sz' v))
  (Hvextract: ∀ {sz sz':size} (v:sbitvec sz) highbit lowbit
      (H:sz'.val = highbit - lowbit + 1),
      P' v → P' (sbitvec.extract highbit lowbit H v))
  (Hvite: ∀ {sz} (b:sbool) (v1 v2:sbitvec sz), P b → P' v1 → P' v2 →
      P' (sbitvec.ite b v1 v2))

@[reducible]
mutual def sbool.induction, sbitvec.induction
with sbool.induction : ∀ b, P b
| sbool.tt := Hbtt
| sbool.ff := Hbff
| (sbool.var b) := Hbvar b
| (sbool.and b1 b2) := Hband b1 b2 (sbool.induction b1) (sbool.induction b2)
| (sbool.or b1 b2) := Hbor b1 b2 (sbool.induction b1) (sbool.induction b2)
| (sbool.xor b1 b2) := Hbxor b1 b2 (sbool.induction b1) (sbool.induction b2)
| (sbool.eqb b1 b2) := Hbeqb b1 b2 (sbool.induction b1) (sbool.induction b2)
| (sbool.neb b1 b2) := Hbneb b1 b2 (sbool.induction b1) (sbool.induction b2)
| (sbool.ite b1 b2 b3) := Hbite b1 b2 b3 (sbool.induction b1) (sbool.induction b2) (sbool.induction b3)
| (sbool.not b) := Hbnot b (sbool.induction b)
| (@sbool.eqbv sz v1 v2) :=
    have 0 < sbitvec.sizeof sz v1, by apply sbitvec.decr_sbitvec,
    have 0 < sbitvec.sizeof sz v2, by apply sbitvec.decr_sbitvec,
    Hbeqbv v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| (@sbool.nebv sz v1 v2) :=
    have 0 < sbitvec.sizeof sz v1, by apply sbitvec.decr_sbitvec,
    have 0 < sbitvec.sizeof sz v2, by apply sbitvec.decr_sbitvec,
    Hbnebv v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| (@sbool.sle sz v1 v2) :=
    have 0 < sbitvec.sizeof sz v1, by apply sbitvec.decr_sbitvec,
    have 0 < sbitvec.sizeof sz v2, by apply sbitvec.decr_sbitvec,
    Hbsle v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| (@sbool.slt sz v1 v2) :=
    have 0 < sbitvec.sizeof sz v1, by apply sbitvec.decr_sbitvec,
    have 0 < sbitvec.sizeof sz v2, by apply sbitvec.decr_sbitvec,
    Hbslt v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| (@sbool.ule sz v1 v2) :=
    have 0 < sbitvec.sizeof sz v1, by apply sbitvec.decr_sbitvec,
    have 0 < sbitvec.sizeof sz v2, by apply sbitvec.decr_sbitvec,
    Hbule v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| (@sbool.ult sz v1 v2) :=
    have 0 < sbitvec.sizeof sz v1, by apply sbitvec.decr_sbitvec,
    have 0 < sbitvec.sizeof sz v2, by apply sbitvec.decr_sbitvec,
    Hbult v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
with sbitvec.induction: ∀ {sz:size} (v:sbitvec sz), P' v
| _ (sbitvec.const sz n) := Hvconst sz n
| _ (sbitvec.var sz n) := Hvvar sz n
| _ (sbitvec.add v1 v2) := Hvadd v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.sub v1 v2) := Hvsub v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.mul v1 v2) := Hvmul v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.udiv v1 v2) := Hvudiv v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.urem v1 v2) := Hvurem v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.sdiv v1 v2) := Hvsdiv v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.srem v1 v2) := Hvsrem v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.and v1 v2) := Hvand v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.or v1 v2) := Hvor v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.xor v1 v2) := Hvxor v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.shl v1 v2) := Hvshl v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.lshr v1 v2) := Hvlshr v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.ashr v1 v2) := Hvashr v1 v2 (sbitvec.induction v1) (sbitvec.induction v2)
| _ (sbitvec.zext sz' v) := Hvzext v sz' (sbitvec.induction v)
| _ (sbitvec.sext sz' v) := Hvsext v sz' (sbitvec.induction v)
| _ (sbitvec.trunc sz' v) := Hvtrunc v sz' (sbitvec.induction v)
| _ (sbitvec.extract h l H v) := Hvextract v h l H (sbitvec.induction v)
| _ (sbitvec.ite b v1 v2) := Hvite b v1 v2 (sbool.induction b)
      (sbitvec.induction v1) (sbitvec.induction v2)

end

lemma env.replace_sb_and0: ∀ (b1 b2:sbool) (η:freevar.env),
  η⟦sbool.and b1 b2⟧ = sbool.and (η⟦b1⟧) (η⟦b2⟧)
:= begin intros, unfold freevar.env.replace_sb end
lemma env.replace_sb_and: ∀ (b1 b2:sbool) (η:freevar.env),
  η⟦b1 & b2⟧ = η⟦b1⟧ & η⟦b2⟧
:= begin intros, apply env.replace_sb_and0 end

lemma env.replace_sb_or0: ∀ (b1 b2:sbool) (η:freevar.env),
  η⟦sbool.or b1 b2⟧ = sbool.or (η⟦b1⟧) (η⟦b2⟧)
:= begin intros, unfold freevar.env.replace_sb end
lemma env.replace_sb_or: ∀ (b1 b2:sbool) (η:freevar.env),
  η⟦b1 |b b2⟧ = η⟦b1⟧ |b η⟦b2⟧
:= begin intros, apply env.replace_sb_or0 end

lemma env.replace_sb_not0: ∀ (b:sbool) (η:freevar.env),
  η⟦sbool.not b⟧ = sbool.not (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sb end
lemma env.replace_sb_not: ∀ (b:sbool) (η:freevar.env),
  η⟦~ b⟧ = ~ η⟦b⟧
:= begin intros, apply env.replace_sb_not0 end

lemma env.replace_sb_eqbv: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbool.eqbv a b⟧ = sbool.eqbv (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sb end

lemma env.replace_sb_nebv: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbool.nebv a b⟧ = sbool.nebv (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sb end

lemma env.replace_sb_sle: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbool.sle a b⟧ = sbool.sle (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sb end

lemma env.replace_sb_slt: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbool.slt a b⟧ = sbool.slt (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sb end

lemma env.replace_sb_ule: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbool.ule a b⟧ = sbool.ule (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sb end

lemma env.replace_sb_ult: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbool.ult a b⟧ = sbool.ult (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sb end

lemma env.replace_sb_ite: ∀ (c:sbool) (a b:sbool) (η:freevar.env),
  η⟦sbool.ite c a b⟧ = sbool.ite (η⟦c⟧) (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sb end

lemma env.replace_b2p: ∀ (b:sbool) (η:freevar.env),
  η⟦b2p irsem_smt b⟧ = b2p irsem_smt (η⟦b⟧)
:= begin
  intros,
  unfold b2p,
  unfold has_ite.ite,
  unfold freevar.env.replace_sb,
  refl
end

lemma env.replace_sb_of_bool: ∀ (a:bool) (η:freevar.env),
  η⟦sbool.of_bool a⟧ = sbool.of_bool a
:= begin
  intros, cases a; refl
end

lemma env.replace_eq2p: ∀ {sz:size} (v1:sbitvec sz) (v2:sbitvec sz) (η:freevar.env),
  η⟦irsem.eq2p irsem_smt v1 v2⟧ = (irsem.eq2p irsem_smt (η⟦v1⟧) (η⟦v2⟧))
:= begin
  intros,
  unfold eq2p,
  unfold has_ne.ne,
  unfold has_comp.ne,
  have HNE: sbool.nebv (η⟦v1⟧) (η⟦v2⟧) = η⟦sbool.nebv v1 v2⟧,
  {
    unfold freevar.env.replace_sb
  },
  rw HNE,
  apply env.replace_b2p,
end

lemma env.replace_neq2p: ∀ {sz:size} (v1:sbitvec sz) (v2:sbitvec sz) (η:freevar.env),
  η⟦irsem.neq2p irsem_smt v1 v2⟧ = (irsem.neq2p irsem_smt (η⟦v1⟧) (η⟦v2⟧))
:= begin
  intros,
  unfold neq2p,
  unfold has_eq.eq,
  unfold has_comp.eq,
  have HNE: sbool.eqbv (η⟦v1⟧) (η⟦v2⟧) = η⟦sbool.eqbv v1 v2⟧,
  {
    unfold freevar.env.replace_sb
  },
  rw HNE,
  apply env.replace_b2p,
end

lemma env.replace_eq2p': ∀ {sz:size} (v1:sbitvec sz) (v2:sbitvec sz) (η:freevar.env)
    (H:v2 = η⟦v2⟧),
  (irsem.eq2p irsem_smt (η⟦v1⟧) v2) = η⟦irsem.eq2p irsem_smt v1 v2⟧
:= begin
  intros,
  have H0: irsem.eq2p irsem_smt (η⟦v1⟧) v2 = irsem.eq2p irsem_smt (η⟦v1⟧) (η⟦v2⟧),
  { rw ← H },
  rw H0,
  rw ← env.replace_eq2p
end

-- replace_sbv

lemma env.replace_sbv_add: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.add a b⟧ = sbitvec.add (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_sub: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.sub a b⟧ = sbitvec.sub (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_mul: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.mul a b⟧ = sbitvec.mul (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_udiv: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.udiv a b⟧ = sbitvec.udiv (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_urem: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.urem a b⟧ = sbitvec.urem (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_sdiv: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.sdiv a b⟧ = sbitvec.sdiv (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_srem: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.srem a b⟧ = sbitvec.srem (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_shl: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.shl a b⟧ = sbitvec.shl (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_lshr: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.lshr a b⟧ = sbitvec.lshr (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_ashr: ∀ {sz:size} (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.ashr a b⟧ = sbitvec.ashr (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_mk_zext: ∀ {sz sz2:size} (a:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.mk_zext sz2 a⟧ = sbitvec.mk_zext sz2 (η⟦a⟧)
:= begin intros, unfold sbitvec.mk_zext, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_mk_sext: ∀ {sz sz2:size} (a:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.mk_sext sz2 a⟧ = sbitvec.mk_sext sz2 (η⟦a⟧)
:= begin intros, unfold sbitvec.mk_sext, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_trunc: ∀ {sz sz':size} (b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.trunc sz' b⟧ = sbitvec.trunc sz' (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_zext: ∀ {sz sz':size} (b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.zext sz' b⟧ = sbitvec.zext sz' (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_sext: ∀ {sz sz':size} (b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.sext sz' b⟧ = sbitvec.sext sz' (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_extract: ∀ {sz sz':size} (b:sbitvec sz) (η:freevar.env) h l
    (H:sz'.val = h - l + 1),
  η⟦sbitvec.extract h l H b⟧ = sbitvec.extract h l H (η⟦b⟧)
:= begin
  intros,
  unfold freevar.env.replace_sbv
end

lemma env.replace_sbv_ite: ∀ {sz:size} (c:sbool) (a b:sbitvec sz) (η:freevar.env),
  η⟦sbitvec.ite c a b⟧ = sbitvec.ite (η⟦c⟧) (η⟦a⟧) (η⟦b⟧)
:= begin intros, unfold freevar.env.replace_sbv end

lemma env.replace_sbv_of_int: ∀ sz z (η:freevar.env),
  η⟦sbitvec.of_int sz z⟧ = sbitvec.of_int sz z
:= begin
  intros,
  cases sz,
  cases z;
  {
    unfold sbitvec.of_int,
    unfold freevar.env.replace_sbv
  }
end

lemma env.replace_sbv_of_bool: ∀ (a:sbool) (η:freevar.env),
  η⟦sbitvec.of_bool a⟧ = sbitvec.of_bool (η⟦a⟧)
:= begin
  intros, unfold sbitvec.of_bool, rw env.replace_sbv_ite,
  unfold sbitvec.zero, unfold sbitvec.one,
  rw env.replace_sbv_of_int, rw env.replace_sbv_of_int
end

lemma env.replace_idemp :
  (∀ (η:freevar.env) (b:sbool), η⟦η⟦b⟧⟧ = η⟦b⟧) ∧
  (∀ {sz:size} (η:freevar.env) (b:sbitvec sz), η⟦η⟦b⟧⟧ = η⟦b⟧)
:= begin
  split; intros; revert b,
  apply (sbool.induction (λ b, η⟦η⟦b⟧⟧ = η⟦b⟧)
                        (λ {sz:size} (v:sbitvec sz), η⟦η⟦v⟧⟧ = η⟦v⟧)),
  any_goals  {
    apply (sbitvec.induction (λ b, η⟦η⟦b⟧⟧ = η⟦b⟧)
                          (λ {sz:size} (v:sbitvec sz), η⟦η⟦v⟧⟧ = η⟦v⟧))
  },
  any_goals
  { refl },
  -- sbool
  any_goals {
    intros b1 b2 H1 H2,
    unfold freevar.env.replace_sb, rw [H1, H2], done
  },
  any_goals {
    intros,
    unfold freevar.env.replace_sb,
    generalize Hb': η.b s = b',
    cases b',
    { unfold freevar.env.replace_sb._match_1,
      unfold freevar.env.replace_sb,
      rw Hb', refl
    },
    { unfold freevar.env.replace_sb._match_1,
      cases b'; refl
    }
  },
  any_goals { intros b1 b2 b3 H1 H2 H3,
    unfold freevar.env.replace_sb, rw [H1, H2, H3], done
  },
  any_goals { intros b H,
    unfold freevar.env.replace_sb, rw H, done
  },
  any_goals { intros sz v1 v2 H1 H2,
    unfold freevar.env.replace_sb, rw H1, rw H2, done
  },
  -- sbitvec
  any_goals
  { intros, unfold freevar.env.replace_sbv, done },
  any_goals {
    intros sz v1 v2 H1 H2,
    unfold freevar.env.replace_sbv, rw [H1, H2], done
  },
  any_goals {
    intros,
    unfold freevar.env.replace_sbv,
    generalize Hb': η.bv n = b',
    cases b'; unfold freevar.env.replace_sbv._match_1,
    { unfold freevar.env.replace_sbv,
      rw Hb', refl
    },
    { rw env.replace_sbv_of_int }, done
  },
  any_goals {
    intros sz v' sz' H,
    unfold freevar.env.replace_sbv, rw H, done
  },
  any_goals {
    intros sz sz' v highbit lowbit H H',
    unfold freevar.env.replace_sbv,
    rw H', done
  },
  any_goals {
    intros sz b v1 v2 H H1 H2,
    unfold freevar.env.replace_sbv,
    rw [H, H1, H2]
  }
end

lemma env.replace_sb_idemp: ∀ (η:freevar.env) (b:sbool), η⟦η⟦b⟧⟧ = η⟦b⟧
:= begin
  apply (and.elim_left env.replace_idemp)
end

lemma env.replace_sbv_idemp: ∀ {sz} (η:freevar.env) (b:sbitvec sz), η⟦η⟦b⟧⟧ = η⟦b⟧
:= begin
  intros,
  apply (and.elim_right env.replace_idemp)
end

lemma env.empty_replace: (∀ (b:sbool), freevar.env.empty⟦b⟧ = b) ∧
  (∀ {sz} (b:sbitvec sz), freevar.env.empty⟦b⟧ = b)
:= begin
  intros,
  split; intros; revert b,
  apply (sbool.induction (λ b, freevar.env.empty⟦b⟧ = b)
              (λ {sz:size} (v:sbitvec sz), freevar.env.empty⟦v⟧ = v)),
  any_goals {
    apply (sbitvec.induction (λ b, freevar.env.empty⟦b⟧ = b)
              (λ {sz:size} (v:sbitvec sz), freevar.env.empty⟦v⟧ = v)),
  },
  any_goals { refl },
  any_goals {
    intros,
    unfold freevar.env.replace_sb,
    unfold freevar.env.empty,
    simp, done
  },
  any_goals {
    intros b H, unfold freevar.env.replace_sb, rw H
  },
  any_goals {
    intros b1 b2 H1 H2, unfold freevar.env.replace_sb, rw [H1, H2], done
  },
  any_goals {
    intros b b1 b2 H H1 H2, unfold freevar.env.replace_sb, rw [H, H1, H2], done
  },
  any_goals {
    intros sz b1 b2 H1 H2, unfold freevar.env.replace_sb, rw [H1, H2], done
  },
  -- sbitvec
  any_goals
  { intros, unfold freevar.env.replace_sbv, done },
  any_goals {
    intros sz v1 v2 H1 H2,
    unfold freevar.env.replace_sbv, rw [H1, H2], done
  },
  any_goals {
    intros,
    unfold freevar.env.replace_sbv,
    unfold freevar.env.empty,
    simp, done
  },
  any_goals {
    intros sz v' sz' H,
    unfold freevar.env.replace_sbv, rw H, done
  },
  any_goals {
    intros sz sz' v highbit lowbit H H',
    unfold freevar.env.replace_sbv,
    rw H', done
  },
  any_goals {
    intros sz b v1 v2 H H1 H2,
    unfold freevar.env.replace_sbv,
    rw [H, H1, H2]
  }
end

lemma env.empty_replace_sb: ∀ (b:sbool), freevar.env.empty⟦b⟧ = b
:= begin
  apply (and.elim_left env.empty_replace)
end

lemma env.empty_replace_sbv {sz:size} : ∀ (b:sbitvec sz), freevar.env.empty⟦b⟧ = b
:= begin
  apply (and.elim_right env.empty_replace)
end

lemma env.replace_sbv_cast: ∀ {sz sz':size} {H:sz = sz'} {H':sbitvec sz = sbitvec sz'}
    (b:sbitvec sz) (η:freevar.env),
  η⟦cast H' b⟧ = cast H' (η⟦b⟧)
:= begin
  intros,
  induction H,
  unfold cast
end

lemma env.replace_sb_overflowchk_add: ∀
    {sz1:size} (sz2:size) (v1 v2:sbitvec sz1) nsw (η:freevar.env),
  η⟦sbitvec.overflow_chk @sbitvec.add sz2 nsw v1 v2⟧ =
    sbitvec.overflow_chk @sbitvec.add sz2 nsw (η⟦v1⟧) (η⟦v2⟧)
:= begin
  intros, unfold sbitvec.overflow_chk,
  cases nsw; simp, rw env.replace_sbv_of_int
end

lemma env.replace_sb_overflowchk_sub: ∀
    {sz1:size} (sz2:size) (v1 v2:sbitvec sz1) nsw (η:freevar.env),
  η⟦sbitvec.overflow_chk @sbitvec.sub sz2 nsw v1 v2⟧ =
    sbitvec.overflow_chk @sbitvec.sub sz2 nsw (η⟦v1⟧) (η⟦v2⟧)
:= begin
  intros, unfold sbitvec.overflow_chk,
  cases nsw; simp, rw env.replace_sbv_of_int
end

lemma env.replace_sb_overflowchk_mul: ∀
    {sz1:size} (sz2:size) (v1 v2:sbitvec sz1) nsw (η:freevar.env),
  η⟦sbitvec.overflow_chk @sbitvec.mul sz2 nsw v1 v2⟧ =
    sbitvec.overflow_chk @sbitvec.mul sz2 nsw (η⟦v1⟧) (η⟦v2⟧)
:= begin
  intros, unfold sbitvec.overflow_chk,
  cases nsw; simp, rw env.replace_sbv_of_int
end

lemma env.replace_sb_overflowchk_shl: ∀
    {sz1:size} (sz2:size) (v1 v2:sbitvec sz1) nsw (η:freevar.env),
  η⟦sbitvec.shl_overflow_chk sz2 nsw v1 v2⟧ =
    sbitvec.shl_overflow_chk sz2 nsw (η⟦v1⟧) (η⟦v2⟧)
:= begin
  intros, unfold sbitvec.shl_overflow_chk,
  unfold sbitvec.overflow_chk,
  cases nsw; simp,
  { repeat { rw env.replace_sbv_of_int }, tauto },
  { rw env.replace_sbv_of_int, tauto }
end

-- irstate

lemma getreg_replace_none: ∀ ss ss' (η:freevar.env) (name name':string)
    (H:irstate.getreg irsem_smt ss name = none)
    (H':ss' = η⟦ss⟧),
  irstate.getreg irsem_smt ss' name = none
:= begin
  intros,
  unfold freevar.env.replace at H',
  rw H',
  rw ← irstate.getreg_apply_none_smt,
  assumption
end

lemma getreg_replace_none_inv: ∀ ss ss' (η:freevar.env) (name name':string)
    (H:irstate.getreg irsem_smt ss' name = none)
    (H':ss' = η⟦ss⟧),
  irstate.getreg irsem_smt ss name = none
:= begin
  intros,
  unfold freevar.env.replace at H',
  rw H' at H,
  rw irstate.getreg_apply_none_smt,
  assumption
end

lemma getreg_replace: ∀ {ss:irstate_smt} {name:string} {η:freevar.env} {ov}
    (HV:irstate.getreg irsem_smt ss name = ov),
  irstate.getreg irsem_smt (η⟦ss⟧) name = η⟦ov⟧'
:= begin
  intros,
  revert ov,
  unfold irstate.getreg at *,
  unfold freevar.env.replace at *,
  unfold irstate.apply_to_values at *,
  cases ss with ss_ub ss_rf,
  apply regfile.induction ss_rf,
  {
    intros ov H,
    unfold irstate.setub, simp at *,
    rw regfile.empty_apply_empty,
    rw regfile.empty_get_none at *, rw ← H
  },
  {
    intros rf Hind n v ov H,
    unfold irstate.setub, simp at *,
    rw regfile.apply_update_comm,
    have HNAME: decidable (n = name), apply_instance,
    cases HNAME,
    {
      rw regfile.update_get_nomatch,
      apply Hind,
      { rw regfile.update_get_nomatch at H, apply H,
        apply neq_symm, assumption },
      { apply neq_symm, assumption }
    },
    {
      rw regfile.update_get_match,
      rw regfile.update_get_match at H,
      rw ← H, rw HNAME, rw HNAME
    }
  }
end

lemma replace_updatereg: ∀ (ss:irstate_smt) (name:string)
    (η:freevar.env) v,
  η⟦irstate.updatereg irsem_smt ss name v⟧ =
    irstate.updatereg irsem_smt (η⟦ss⟧) name (η⟦v⟧)
:= begin
  intros,
  unfold irstate.updatereg,
  unfold freevar.env.replace,
  unfold irstate.apply_to_values,
  congr
end

lemma replace_updateub: ∀ (ss:irstate_smt) (η:freevar.env) ub,
  η⟦irstate.updateub irsem_smt ss ub⟧ =
    irstate.updateub irsem_smt (η⟦ss⟧) (η⟦ub⟧)
:= begin
  intros,
  unfold irstate.updateub,
  unfold freevar.env.replace,
  unfold irstate.apply_to_values,
  unfold irstate.setub,
  unfold irstate.getub,
  simp,
  congr, rw env.replace_sb_and
end

lemma replace_getub: ∀ (ss:irstate_smt) (η:freevar.env),
  η⟦irstate.getub irsem_smt ss⟧ =
    irstate.getub irsem_smt (η⟦ss⟧)
:= begin
  intros,
  unfold irstate.getub,
  cases ss, refl
end

lemma empty_replace_st: ∀ (ss:irstate_smt),
  freevar.env.empty⟦ss⟧ = ss
:= begin
  intros,
  unfold freevar.env.replace,
  cases ss,
  unfold irstate.apply_to_values,
  unfold irstate.setub,
  unfold irstate.getub,
  simp,
  rw prod_inj,
  split,
  { rw env.empty_replace_sb },
  {
    simp,
    revert ss_snd,
    apply regfile.induction,
    { rw regfile.empty_apply_empty },
    {
      intros rf H,
      intros,
      rw regfile.apply_update_comm,
      congr, assumption, cases v,
      unfold freevar.env.replace_valty,
      congr, rw env.empty_replace_sbv, rw env.empty_replace_sb
    }
  }
end

-- ∉

lemma env.not_in_split: ∀ (η:freevar.env) n,
  n ∉ η ↔ η.b n = none ∧ η.bv n = none
:= begin
  intros,
  split; intros H,
  {
    unfold has_mem.mem at H,
    rw decidable.not_or_iff_and_not at H,
    cases H,
    rw ne.def at H_left,
    rw ne.def at H_right,
    rw decidable.not_not_iff at H_left,
    rw decidable.not_not_iff at H_right,
    split; assumption
  },
  {
    unfold has_mem.mem,
    rw decidable.not_or_iff_and_not,
    cases H,
    rw ne.def,
    rw ne.def,
    rw decidable.not_not_iff,
    rw decidable.not_not_iff,
    split; assumption
  }
end

lemma env.in_not_in: ∀ n (η:freevar.env), n ∉ η ∨ n ∈ η
:= begin
  intros,
  rw env.not_in_split,
  unfold has_mem.mem,
  generalize Hb: η.b n = b',
  generalize Hb: η.bv n = bv',
  cases b'; cases bv',
  {
    left, split; refl
  },
  { right, right, intros H, cases H },
  { right, left, intros H, cases H },
  { right, left, intros H, cases H },
end

lemma env.not_in_add_bv: ∀ (η:freevar.env) n1 n2 z
    (HNEQ:n1 ≠ n2)
    (HNOTIN:n1 ∉ η),
  n1 ∉ (η.add_bv n2 z)
:= begin
  intros,
  rw env.not_in_split at *,
  cases HNOTIN,
  unfold freevar.env.add_bv,
  split,
  { simp, assumption },
  { simp, rw if_neg; assumption }
end

lemma env.not_in_add_b: ∀ (η:freevar.env) n1 n2 z
    (HNEQ:n1 ≠ n2)
    (HNOTIN:n1 ∉ η),
  n1 ∉ (η.add_b n2 z)
:= begin
  intros,
  rw env.not_in_split at *,
  cases HNOTIN,
  unfold freevar.env.add_b,
  split,
  { simp, rw if_neg; assumption },
  { simp, assumption }
end

lemma env.not_in_empty: ∀ n, n ∉ freevar.env.empty
:= begin
  intros, rw env.not_in_split,
  split; refl
end

-- replace_sb, repalce_sbv

lemma env.not_in_replace_sb: ∀ (η:freevar.env) n
    (HNOTIN:n ∉ η),
  η⟦sbool.var n⟧ = sbool.var n
:= begin
  intros,
  rw env.not_in_split at *,
  cases HNOTIN,
  unfold freevar.env.replace_sb,
  generalize H:η.b n = g,
  cases g,
  { refl },
  { rw HNOTIN_left at H, cases H }
end

lemma env.not_in_replace_sbv: ∀ (η:freevar.env) n sz
    (HNOTIN:n ∉ η),
  η⟦sbitvec.var sz n⟧ = sbitvec.var sz n
:= begin
  intros,
  rw env.not_in_split at *,
  cases HNOTIN,
  unfold freevar.env.replace_sbv,
  generalize H:η.bv n = g,
  cases g,
  { refl },
  { rw HNOTIN_right at H, cases H }
end

lemma env.in_replace_sbv: ∀ (η:freevar.env) n sz
    (HIN:∃ z, η.bv n = some z),
  ∃ z, η⟦sbitvec.var sz n⟧ = sbitvec.const sz z
:= begin
  intros,
  cases HIN with z HIN,
  unfold freevar.env.replace_sbv,
  rw HIN,
  unfold freevar.env.replace_sbv._match_1,
  cases z; unfold sbitvec.of_int,
  apply exists.intro, refl,
  apply exists.intro, refl
end

lemma env.sbv_var_or_const: ∀ (η:freevar.env) sz n,
  η⟦sbitvec.var sz n⟧ = sbitvec.var sz n ∨
  ∃ z, η⟦sbitvec.var sz n⟧ = sbitvec.const sz z
:= begin
  intros,
  unfold freevar.env.replace_sbv,
  generalize H: (η.bv n) = b,
  cases b,
  {
    unfold freevar.env.replace_sbv._match_1,
    left, refl
  },
  {
    unfold freevar.env.replace_sbv._match_1,
    right, cases b; unfold sbitvec.of_int,
    apply exists.intro, refl,
    apply exists.intro, refl
  }
end

lemma env.sb_var_or_const: ∀ (η:freevar.env) n,
  η⟦sbool.var n⟧ = sbool.var n ∨
  η⟦sbool.var n⟧ = sbool.tt ∨
  η⟦sbool.var n⟧ = sbool.ff
:= begin
  intros,
  unfold freevar.env.replace_sb,
  generalize H: (η.b n) = b,
  cases b,
  {
    unfold freevar.env.replace_sb._match_1,
    left, refl
  },
  {
    unfold freevar.env.replace_sb._match_1,
    right, cases b, right, refl, left, refl
  }
end

lemma env.not_in_add_bv_replace: ∀ (η:freevar.env) n n2 sz z
    (HNEQ:n ≠ n2),
  (η.add_bv n2 z)⟦sbitvec.var sz n⟧ = η⟦sbitvec.var sz n⟧
:= begin
  intros,
  unfold freevar.env.replace_sbv,
  unfold freevar.env.add_bv,
  simp,
  rw if_neg, assumption
end

lemma env.not_in_add_b_replace: ∀ (η:freevar.env) n n2 z
    (HNEQ:n ≠ n2),
  (η.add_b n2 z)⟦sbool.var n⟧ = η⟦sbool.var n⟧
:= begin
  intros,
  unfold freevar.env.replace_sb,
  unfold freevar.env.add_b,
  simp,
  rw if_neg, assumption
end

lemma env.add_b_replace_match: ∀ (η:freevar.env) n b,
  (freevar.env.add_b η n b)⟦sbool.var n⟧ = sbool.of_bool b
:= begin
  intros,
  unfold freevar.env.replace_sb,
  unfold freevar.env.add_b,
  simp
end

lemma env.add_bv_replace_match: ∀ (η:freevar.env) n z sz,
  (freevar.env.add_bv η n z)⟦sbitvec.var sz n⟧ = sbitvec.of_int sz z
:= begin
  intros,
  unfold freevar.env.replace_sbv,
  unfold freevar.env.add_bv,
  simp
end

lemma env.add_bv_replace_sb: ∀ (η:freevar.env) n n' z,
  (freevar.env.add_bv η n z)⟦sbool.var n'⟧ = η⟦sbool.var n'⟧
:= begin
  intros,
  unfold freevar.env.replace_sb,
  unfold freevar.env.add_bv
end

lemma env.add_b_replace_sbv: ∀ (η:freevar.env) n n' b sz,
  (freevar.env.add_b η n b)⟦sbitvec.var sz n'⟧ = η⟦sbitvec.var sz n'⟧
:= begin
  intros,
  unfold freevar.env.replace_sbv,
  unfold freevar.env.add_b
end

lemma env.replace_sb_cases: ∀ s (η:freevar.env),
  η⟦sbool.var s⟧ = sbool.var s ∨ η⟦sbool.var s⟧ = sbool.tt ∨ η⟦sbool.var s⟧ = sbool.ff
:= begin
  intros,
  unfold freevar.env.replace_sb,
  generalize Hb: η.b s = b',
  rw Hb at *, cases b'; unfold freevar.env.replace_sb._match_1,
  { left, refl },
  {
    right,
    cases b'; unfold sbool.of_bool; simp
  }
end

lemma env.replace_sbv_cases: ∀ sz s (η:freevar.env),
  η⟦sbitvec.var sz s⟧ = sbitvec.var sz s
    ∨ ∃ n, η⟦sbitvec.var sz s⟧ = sbitvec.const sz n
:= begin
  intros,
  unfold freevar.env.replace_sbv,
  generalize Hb: η.bv s = b',
  rw Hb at *, cases b'; unfold freevar.env.replace_sbv._match_1,
  { left, refl },
  {
    right,
    cases b'; unfold sbitvec.of_int,
    apply exists.intro, refl, apply exists.intro, refl
  }
end

lemma env.not_in_add_b_bv_bv_comm: ∀ (η:freevar.env) z,
  (∀ (v:sbool) n, n ∉ η → (η.add_bv n z)⟦v⟧ =
      (freevar.env.empty.add_bv n z)⟦η⟦v⟧⟧) ∧
  (∀ {sz} (v:sbitvec sz) n, n ∉ η →
        (η.add_bv n z)⟦v⟧ = (freevar.env.empty.add_bv n z)⟦η⟦v⟧⟧)
:= begin
  intros,
  split,
  apply sbool.induction
      (λ v, ∀ n, n ∉ η → (η.add_bv n z)⟦v⟧ = (freevar.env.empty.add_bv n z)⟦η⟦v⟧⟧)
      (λ {sz} (v:sbitvec sz), ∀ n, n ∉ η →
            (η.add_bv n z)⟦v⟧ = (freevar.env.empty.add_bv n z)⟦η⟦v⟧⟧),
  any_goals {
    apply sbitvec.induction
      (λ v, ∀ n, n ∉ η → (η.add_bv n z)⟦v⟧ = (freevar.env.empty.add_bv n z)⟦η⟦v⟧⟧)
      (λ {sz} (v:sbitvec sz), ∀ n, n ∉ η →
            (η.add_bv n z)⟦v⟧ = (freevar.env.empty.add_bv n z)⟦η⟦v⟧⟧),
  },
  any_goals { intros, refl },
  any_goals {
    intros,
    unfold freevar.env.add_bv,
    unfold freevar.env.replace_sb,
    simp,
    unfold freevar.env.empty,
    generalize HG: η.b s = b',
    cases b',
    {
      unfold freevar.env.replace_sb._match_1,
      unfold freevar.env.replace_sb,
    },
    {
      unfold freevar.env.replace_sb._match_1,
      rw env.replace_sb_of_bool, done
    }
  },
  any_goals {
    intros b1 b2 H1 H2 n' HNOTIN',
    unfold freevar.env.replace_sb at *,
    rw [H1, H2]; assumption
  },
  any_goals {
    intros b1 b2 b3 H1 H2 H3 n' HNOTIN',
    unfold freevar.env.replace_sb at *,
    rw [H1, H2, H3]; assumption
  },
  any_goals {
    intros b H n' HNOTIN',
    unfold freevar.env.replace_sb at *,
    rw [H], assumption
  },
  any_goals {
    intros sz b1 b2 H1 H2 n' HNOTIN',
    unfold freevar.env.replace_sb at *,
    rw [H1, H2]; assumption
  },
  any_goals {
    intros,
    unfold freevar.env.replace_sbv at *, done
  },
  any_goals {
    intros sz n',
    intros n'' HNOTIN',
    have HEQ:decidable (n' = n''), apply_instance,
    cases HEQ,
    {
      have H:= env.sbv_var_or_const η sz n',
      cases H,
      {
        rw env.not_in_add_bv_replace,
        rw H,
        rw env.not_in_add_bv_replace,
        rw env.empty_replace_sbv,
        assumption, assumption
      },
      {
        cases H with z' H,
        rw env.not_in_add_bv_replace,
        rw H,
        unfold freevar.env.replace_sbv,
        assumption
      }
    },
    {
      rw HEQ,
      rw env.add_bv_replace_match,
      rw env.not_in_replace_sbv,
      rw env.add_bv_replace_match,
      assumption
    }
  },
  any_goals {
    intros sz v1 v2 H1 H2 n' HNOTIN',
    unfold freevar.env.replace_sbv at *,
    rw [H1, H2]; assumption
  },
  any_goals {
    intros sz v sz' H n' HNOTIN',
    unfold freevar.env.replace_sbv at *,
    rw H, assumption
  },
  any_goals {
    intros sz sz' v highbit lowbit HH H n' HNOTIN',
    unfold freevar.env.replace_sbv at *,
    rw H, assumption
  },
  any_goals {
    intros sz v1 v2 v3 H1 H2 H3 n' HNOTIN',
    unfold freevar.env.replace_sbv at *,
    rw [H1, H2, H3]; assumption
  }
end

lemma env.not_in_add_bv_b_comm: ∀ (η:freevar.env) z (v:sbool) n,
  n ∉ η → (η.add_bv n z)⟦v⟧ = (freevar.env.empty.add_bv n z)⟦η⟦v⟧⟧
:= begin
  intros, apply (and.elim_left (env.not_in_add_b_bv_bv_comm η z)),
  assumption
end

lemma env.not_in_add_bv_bv_comm: ∀ (η:freevar.env) z {sz} (v:sbitvec sz) n,
  n ∉ η → (η.add_bv n z)⟦v⟧ = (freevar.env.empty.add_bv n z)⟦η⟦v⟧⟧
:= begin
  intros, apply (and.elim_right (env.not_in_add_b_bv_bv_comm η z)),
  assumption
end

lemma env.not_in_add_b_bv_b_comm: ∀ (η:freevar.env) z,
  (∀ (v:sbool) n, n ∉ η → (η.add_b n z)⟦v⟧ =
      (freevar.env.empty.add_b n z)⟦η⟦v⟧⟧) ∧
  (∀ {sz} (v:sbitvec sz) n, n ∉ η →
        (η.add_b n z)⟦v⟧ = (freevar.env.empty.add_b n z)⟦η⟦v⟧⟧)
:= begin
  intros,
  split,
  apply sbool.induction
      (λ v, ∀ n, n ∉ η → (η.add_b n z)⟦v⟧ = (freevar.env.empty.add_b n z)⟦η⟦v⟧⟧)
      (λ {sz} (v:sbitvec sz), ∀ n, n ∉ η →
            (η.add_b n z)⟦v⟧ = (freevar.env.empty.add_b n z)⟦η⟦v⟧⟧),
  any_goals {
    apply sbitvec.induction
      (λ v, ∀ n, n ∉ η → (η.add_b n z)⟦v⟧ = (freevar.env.empty.add_b n z)⟦η⟦v⟧⟧)
      (λ {sz} (v:sbitvec sz), ∀ n, n ∉ η →
            (η.add_b n z)⟦v⟧ = (freevar.env.empty.add_b n z)⟦η⟦v⟧⟧),
  },
  any_goals { intros, refl },
  any_goals {
    intros n',
    intros n'' HNOTIN',
    have HEQ:decidable (n' = n''), apply_instance,
    cases HEQ,
    {
      have H:= env.sb_var_or_const η n',
      cases H,
      {
        rw env.not_in_add_b_replace,
        rw H,
        rw env.not_in_add_b_replace,
        rw env.empty_replace_sb,
        assumption, assumption
      },
      {
        cases H,
        any_goals {rw env.not_in_add_b_replace,
          rw H,
          unfold freevar.env.replace_sb,
          assumption }
      }
    },
    {
      rw HEQ,
      rw env.add_b_replace_match,
      rw env.not_in_replace_sb,
      rw env.add_b_replace_match,
      assumption
    }
  },
  any_goals {
    intros b1 b2 H1 H2 n' HNOTIN',
    unfold freevar.env.replace_sb at *,
    rw [H1, H2]; assumption
  },
  any_goals {
    intros b1 b2 b3 H1 H2 H3 n' HNOTIN',
    unfold freevar.env.replace_sb at *,
    rw [H1, H2, H3]; assumption
  },
  any_goals {
    intros b H n' HNOTIN',
    unfold freevar.env.replace_sb at *,
    rw [H], assumption
  },
  any_goals {
    intros sz b1 b2 H1 H2 n' HNOTIN',
    unfold freevar.env.replace_sb at *,
    rw [H1, H2]; assumption
  },
  any_goals {
    intros,
    unfold freevar.env.replace_sbv at *, done
  },
  any_goals {
    intros,
    unfold freevar.env.add_b,
    unfold freevar.env.replace_sbv,
    simp,
    unfold freevar.env.empty,
    generalize HG: η.bv n = b',
    cases b',
    {
      unfold freevar.env.replace_sbv._match_1,
      unfold freevar.env.replace_sbv,
    },
    {
      unfold freevar.env.replace_sbv._match_1,
      simp,
      rw env.replace_sbv_of_int, done
    }
  },
  any_goals {
    intros sz v1 v2 H1 H2 n' HNOTIN',
    unfold freevar.env.replace_sbv at *,
    rw [H1, H2]; assumption
  },
  any_goals {
    intros sz v sz' H n' HNOTIN',
    unfold freevar.env.replace_sbv at *,
    rw H, assumption
  },
  any_goals {
    intros sz sz' v highbit lowbit HH H n' HNOTIN',
    unfold freevar.env.replace_sbv at *,
    rw H, assumption
  },
  any_goals {
    intros sz v1 v2 v3 H1 H2 H3 n' HNOTIN',
    unfold freevar.env.replace_sbv at *,
    rw [H1, H2, H3]; assumption
  }
end

lemma env.not_in_add_b_b_comm: ∀ (η:freevar.env) z (v:sbool) n,
  n ∉ η → (η.add_b n z)⟦v⟧ = (freevar.env.empty.add_b n z)⟦η⟦v⟧⟧
:= begin
  intros, apply (and.elim_left (env.not_in_add_b_bv_b_comm η z)),
  assumption
end

lemma env.not_in_add_b_bv_comm: ∀ (η:freevar.env) z {sz} (v:sbitvec sz) n,
  n ∉ η → (η.add_b n z)⟦v⟧ = (freevar.env.empty.add_b n z)⟦η⟦v⟧⟧
:= begin
  intros, apply (and.elim_right (env.not_in_add_b_bv_b_comm η z)),
  assumption
end

lemma env.not_in_add_bv_valty_comm: ∀ (η:freevar.env) (vv:valty_smt) n z,
  n ∉ η → (η.add_bv n z)⟦vv⟧ = (freevar.env.empty.add_bv n z)⟦η⟦vv⟧⟧
:= begin
  intros,
  cases vv with sz iv pv,
  unfold freevar.env.replace_valty,
  simp,
  rw env.not_in_add_bv_bv_comm,
  rw env.not_in_add_bv_b_comm,
  split, refl, refl,
  assumption, assumption
end

lemma env.not_in_add_b_valty_comm: ∀ (η:freevar.env) (vv:valty_smt) n z,
  n ∉ η → (η.add_b n z)⟦vv⟧ = (freevar.env.empty.add_b n z)⟦η⟦vv⟧⟧
:= begin
  intros,
  cases vv with sz iv pv,
  unfold freevar.env.replace_valty,
  simp,
  rw env.not_in_add_b_bv_comm,
  rw env.not_in_add_b_b_comm,
  split, refl, refl,
  assumption, assumption
end

lemma env.not_in_add_bv_irstate_comm: ∀ (η:freevar.env) (ss:irstate irsem_smt) n z,
  n ∉ η → (η.add_bv n z)⟦ss⟧ = (freevar.env.empty.add_bv n z)⟦η⟦ss⟧⟧
:= begin
  intros,
  cases ss,
  unfold freevar.env.replace,
  rw ← irstate.setub_apply_to_values,
  rw ← irstate.setub_apply_to_values,
  rw ← irstate.setub_apply_to_values,
  rw ← irstate.setub_apply_to_values,
  unfold irstate.getub,
  unfold irstate.setub,
  unfold irstate.apply_to_values,
  unfold regfile.apply_to_values,
  simp,
  rw prod_inj,
  simp,
  split,
  {
    rw env.not_in_add_bv_b_comm, assumption
  },
  {
    induction ss_snd,
    { refl },
    {
      simp,
      rw ss_snd_ih,
      cases ss_snd_hd with rn v,
      cases v with sz iv pv,
      simp,
      rw env.not_in_add_bv_bv_comm,
      rw env.not_in_add_bv_b_comm,
        assumption, assumption
    }
  }
end

lemma env.not_in_add_b_irstate_comm: ∀ (η:freevar.env) (ss:irstate irsem_smt) n z,
  n ∉ η → (η.add_b n z)⟦ss⟧ = (freevar.env.empty.add_b n z)⟦η⟦ss⟧⟧
:= begin
  intros,
  cases ss,
  unfold freevar.env.replace,
  rw ← irstate.setub_apply_to_values,
  rw ← irstate.setub_apply_to_values,
  rw ← irstate.setub_apply_to_values,
  rw ← irstate.setub_apply_to_values,
  unfold irstate.getub,
  unfold irstate.setub,
  unfold irstate.apply_to_values,
  unfold regfile.apply_to_values,
  simp,
  rw prod_inj,
  simp,
  split,
  {
    rw env.not_in_add_b_b_comm, assumption
  },
  {
    induction ss_snd,
    { refl },
    {
      simp,
      rw ss_snd_ih,
      cases ss_snd_hd with rn v,
      cases v with sz iv pv,
      simp,
      rw env.not_in_add_b_bv_comm,
      rw env.not_in_add_b_b_comm,
        assumption, assumption
    }
  }
end

lemma env.has_only_shuffle: ∀ {η:freevar.env} (s:string) (l1 l2:list string),
  env.has_only η (s::(l1 ++ l2)) ↔ env.has_only η (l1 ++ s::l2)
:= begin
  intros, rw ← list.cons_append,
  unfold env.has_only,
  split,
  {
    intros, simp, simp at a,
    rw or.comm, rw or.assoc,
    rw @or.comm (name ∈ l2) (name ∈ l1), apply a
  },
  {
    intros, simp, simp at a,
    rw or.comm, rw or.assoc,
    rw @or.comm (name ∈ l2) (name = s), apply a
  }
end

lemma env.has_only_shuffle2: ∀ {η:freevar.env} (s1 s2:string) (l:list string),
  env.has_only η (s1::s2::l) ↔ env.has_only η (s2::s1::l)
:= begin
  intros,
  unfold env.has_only,
  split,
  {
    intros, simp, simp at a,
    rw or.comm, rw or.assoc,
    rw @or.comm (name ∈ l) (name = s2), apply a
  },
  {
    intros, simp, simp at a,
    rw or.comm, rw or.assoc,
    rw @or.comm (name ∈ l) (name = s1), apply a
  }
end

lemma env.has_only_added2: ∀ {η η':freevar.env} {n1 n2:string}
    {l:list string}
    (H1: env.has_only η l)
    (H2: env.added2 η n1 n2 η'),
  env.has_only η' (n1::n2::l)
:= begin
  intros,
  unfold env.added2 at H2,
  cases H2,
  unfold env.has_only at *,
  intros,
  simp,
  rw H1,
  split,
  { intros, apply H2_right, rw or.comm, rw or.assoc, assumption },
  {
    intros,
    rw ← decidable.not_not_iff (name ∈ η') at a,
    rw ← decidable.not_not_iff (name = n1 ∨ name = n2 ∨ name ∈ η),
    intros H0,
    rw decidable.not_or_iff_and_not at H0,
    rw decidable.not_or_iff_and_not at H0,
    cases H0, cases H0_right,
    apply a,
    apply H2_left, assumption, split; assumption
  }
end

lemma env.has_only_not_in: ∀ {η:freevar.env} {l n}
  (H:env.has_only η l) (HNOTIN:n ∉ l), n ∉ η
:= begin
  intros,
  unfold env.has_only at H,
  intros H0,
  apply HNOTIN, rw H, assumption
end

-- get_value

lemma get_value_replace: ∀ (ss:irstate_smt) (op:operand)
    (η:freevar.env) (t:ty),
  get_value irsem_smt (η⟦ss⟧) op t = η⟦get_value irsem_smt ss op t⟧'
:= begin
  intros,
  cases op,
  { -- operand.reg
    cases op,
    unfold get_value,
    apply getreg_replace, refl
  },
  {
    cases op,
    cases t,
    {
      unfold get_value,
      have H0: decidable (0 < t), apply_instance,
      cases H0,
      { rw dif_neg, assumption },
      {
        rw dif_pos,
        simp,
        have H1: decidable (within_signed_range ⟨t, H0⟩ op), apply_instance,
        cases H1,
        {
          rw if_neg,
          {
            have H2: decidable (↑(int_min_nat ⟨t, H0⟩) ≤ op ∧ op ≤ ↑(all_one_nat ⟨t, H0⟩)),
              apply_instance,
            cases H2,
            { rw if_neg, apply H2 },
            { rw if_pos,
              unfold uint_like.from_z,
              unfold apply,
              unfold freevar.env.replace_valty,
              generalize HCONST: op + -↑(2^t) = c,
              cases c,
              { unfold sbitvec.of_int, unfold freevar.env.replace_sbv, refl },
              { unfold sbitvec.of_int, unfold freevar.env.replace_sbv, refl },
              assumption
            }
          },
          { assumption }
        },
        { rw if_pos,
          unfold uint_like.from_z,
          unfold apply,
          unfold freevar.env.replace_valty,
          cases op,
          { unfold sbitvec.of_int, unfold freevar.env.replace_sbv, refl },
          { unfold sbitvec.of_int, unfold freevar.env.replace_sbv, refl },
          assumption
        }
      }
    },
    { unfold get_value }
  }
end

end spec


import category_theory.limits.shapes.kernels

open category_theory

universes v
namespace category_theory.limits

variables {C D : Type*} [category.{v} C] [category.{v} D]
  [has_zero_morphisms C] [has_zero_morphisms D]

/- These two lemmas are no longer used. -/

@[simp, reassoc]
lemma lift_map_inv_kernel_comparison {X Y Z : C} (f : Y ⟶ Z) [has_kernel f] (G : C ⥤ D)
  [G.preserves_zero_morphisms] [has_kernel (G.map f)] [is_iso (kernel_comparison f G)]
  {g : X ⟶ Y} (w : g ≫ f = 0) :
  kernel.lift (G.map f) (G.map g) (by simp only [← G.map_comp, w, functor.map_zero]) ≫
  category_theory.inv (kernel_comparison f G) = G.map (kernel.lift f g w) :=
by simp [← cancel_mono (kernel_comparison f G)]

@[simp, reassoc]
lemma inv_cokernel_comparison_desc_map {X Y Z : C} (f : X ⟶ Y) [has_cokernel f] (G : C ⥤ D)
  [G.preserves_zero_morphisms] [has_cokernel (G.map f)] [is_iso (cokernel_comparison f G)]
  {g : Y ⟶ Z} (w : f ≫ g = 0) :
  category_theory.inv (cokernel_comparison f G) ≫
    cokernel.desc (G.map f) (G.map g) (by simp only [← G.map_comp, w, functor.map_zero]) =
  G.map (cokernel.desc f g w) :=
by simp [← cancel_epi (cokernel_comparison f G)]

end category_theory.limits


import category_theory.sites.sheafification

open category_theory
open category_theory.limits
open opposite

namespace category_theory.Sheaf

universes w v u

-- All the classes we need for sheafification
variables
  {C : Type u} [category.{v} C]
  (J : grothendieck_topology C)
  {D : Type w} [category.{max v u} D] [concrete_category.{max v u} D]
  [preserves_limits (forget D)]
  [∀ (P : Cᵒᵖ ⥤ D) (X : C) (S : J.cover X), has_multiequalizer (S.index P)]
  [∀ (X : C), has_colimits_of_shape (J.cover X)ᵒᵖ D]
  [∀ (X : C), preserves_colimits_of_shape (J.cover X)ᵒᵖ (forget D)]
  [reflects_isomorphisms (forget D)]

lemma is_iso_of_eval {F : Sheaf J D} {G : Cᵒᵖ ⥤ D}
  (γ : F ⟶ (presheaf_to_Sheaf _ _).obj G)
  (η : F.val ⟶ G)
  [∀ X : C, is_iso (η.app (op X))]
  (h : γ.val = η ≫ J.to_sheafify _) :
  is_iso γ :=
begin
  haveI : is_iso (J.to_sheafify F.val) :=
    grothendieck_topology.is_iso_to_sheafify J F.2,
  have : γ.val = (J.to_sheafify F.val) ≫ (J.sheafify_map η),
  { rw ← is_iso.inv_comp_eq,
    apply J.sheafify_hom_ext, apply Sheaf.cond,
    rw [← grothendieck_topology.to_sheafify_naturality, ← h],
    simp },
  suffices : is_iso ((Sheaf_to_presheaf _ _).map γ),
  { resetI, apply is_iso_of_fully_faithful (Sheaf_to_presheaf J D) },
  dsimp, rw this,
  suffices : is_iso (J.sheafify_map η),
  { resetI, apply is_iso.comp_is_iso },
  change is_iso ((Sheaf_to_presheaf _ _).map ((presheaf_to_Sheaf _ _).map η)),
  haveI : is_iso η,
  { apply_with nat_iso.is_iso_of_is_iso_app { instances := ff },
    intros X, tactic.op_induction', apply_instance },
  apply_instance,
  apply_instance,
end

end category_theory.Sheaf