import algebraic_geometry.AffineScheme
import topology.sheaves.stalks

import about_local_rings
import target_affine_scheme
import random_lemmas

noncomputable theory

/-

# 01J5 Points of Scheme

-/

universes u

namespace algebraic_geometry

open Scheme Top.presheaf opposite topological_space
open category_theory category_theory.concrete_category
open algebraic_geometry

variables (X : Scheme.{u}) (R : Type u) [comm_ring R] [local_ring R]
variable (f : Spec_obj (CommRing.of R) ⟶ X)

instance : local_ring (CommRing.of R) :=
show local_ring R, from infer_instance

structure point_local_ring_hom_pair :=
(pt : X.carrier)
(ring_hom_ : X.presheaf.stalk pt →+* R)
[is_local_ring_hom : is_local_ring_hom ring_hom_]

structure point_local_ring_hom_pair'_aux :=
(pt : X.carrier)
(stalk_ : Type u)
[comm_ring_stalk : comm_ring stalk_]
(stalk_iso : stalk_ ≃+* X.presheaf.stalk pt)
(ring_hom_ : stalk_ →+* R)
[is_local_ring_hom : is_local_ring_hom ring_hom_]

attribute [instance] point_local_ring_hom_pair.is_local_ring_hom
attribute [instance] point_local_ring_hom_pair'_aux.comm_ring_stalk
attribute [instance] point_local_ring_hom_pair'_aux.is_local_ring_hom

namespace point_local_ring_hom_pair'_aux

variables [is_affine X] (P : point_local_ring_hom_pair'_aux X R)

instance stalk_algebra : algebra (Γ.obj $ op X) P.stalk_ :=
ring_hom.to_algebra $ P.stalk_iso.symm.to_ring_hom.comp $
  (stalk_iso_of_affine' X P.pt).symm.to_ring_hom.comp $
  @@algebra_map (Γ.obj $ op X) (localization.at_prime _) _ _
  begin
    dsimp,
    refine localization.algebra,
  end

instance stalk_is_localization :
  @@is_localization _ (X.iso_Spec.hom.1.base P.pt).as_ideal.prime_compl P.stalk_
    _ (by { exactI point_local_ring_hom_pair'_aux.stalk_algebra X R P }) :=
{ map_units := λ y,
  begin
    dsimp,
    rw [ring_hom.algebra_map_to_algebra, ring_hom.comp_apply,
      ring_hom.comp_apply, ←localization.mk_algebra_map],
    erw [algebra.algebra_map_self],
    rw [ring_hom.id_apply],
    refine is_unit.map _ (is_unit.map _ _),
    rw localization.at_prime.mk_is_unit_iff,
    exact y.2,
  end,
  surj := λ z,
  begin
    let z' := P.stalk_iso z,
    have eq0 : P.stalk_iso.symm.to_ring_hom z' = z,
    { erw [ring_equiv.symm_apply_apply] },
    simp_rw [ring_hom.algebra_map_to_algebra, ←eq0, ring_hom.comp_apply,
      ←map_mul],
    sorry
    -- have := localization.is_localization.surj,
  end,
  eq_iff_exists := sorry }

end point_local_ring_hom_pair'_aux

@[ext] lemma point_local_ring_hom_pair_ext (P Q : point_local_ring_hom_pair X R)
  (hpt : P.pt = Q.pt)
  (hhom : P.ring_hom_.comp
  (X.presheaf.stalk_specializes $ by { rw hpt, }) = Q.ring_hom_) :
  P = Q :=
begin
  rcases P with ⟨P, fP, hfP⟩,
  rcases Q with ⟨Q, fQ, hfQ⟩,
  dsimp at hpt,
  subst hpt,
  dsimp at hhom,
  simp_rw ←hhom,
  refine ⟨rfl, heq_of_eq _⟩,
  convert_to fP = fP.comp (ring_hom.id _),
  swap,
  { rw ring_hom.comp_id, },
  congr' 1,
  dunfold stalk_specializes,
  apply limits.colimit.hom_ext,
  intros j,
  rw limits.colimit.ι_desc,
  dsimp only,
  ext x : 1,
  rw [comp_apply, ring_hom.id_apply],
  congr,
  change _ = op (unop j),
  rw op_inj_iff,
  ext : 1,
  refl,
end

namespace point_local_ring_hom_pair'_aux

variables {X R} {p q r : point_local_ring_hom_pair'_aux X R}

@[simps] def stalk_equiv_of_pt_eq (pt_eq : p.pt = q.pt) : p.stalk_ ≃+* q.stalk_ :=
p.stalk_iso.trans $ ring_equiv.trans
(CommRing.from_iso
{ hom := X.presheaf.stalk_specializes (by rw [pt_eq]),
  inv := X.presheaf.stalk_specializes (by rw [pt_eq]),
  hom_inv_id' :=
  begin
    apply stalk_hom_ext,
    intros U hxU,
    erw [←category.assoc, germ_stalk_specializes, germ_stalk_specializes,
      category.comp_id],
    refl,
  end,
  inv_hom_id' :=
  begin
    apply stalk_hom_ext,
    intros U hxU,
    erw [←category.assoc, germ_stalk_specializes, germ_stalk_specializes,
      category.comp_id],
    refl,
  end }) q.stalk_iso.symm

lemma stalk_equiv_of_pt_eq.rfl_apply (x) :
  stalk_equiv_of_pt_eq (rfl : p.pt = p.pt) x = x :=
begin
  simp only [CommRing.from_iso_apply, iso.refl_hom, id_apply,
    stalk_equiv_of_pt_eq_apply],
  obtain ⟨U, hU, s, eq0⟩ := X.presheaf.germ_exist p.pt (p.stalk_iso x),
  rw [←eq0, germ_stalk_specializes'_apply],
  apply_fun p.stalk_iso,
  rw [ring_equiv.apply_symm_apply, ←eq0],
  refl,

  exact equiv_like.injective p.stalk_iso,
end

lemma stalk_equiv_of_pt_eq.symm (pt_eq : p.pt = q.pt) :
  stalk_equiv_of_pt_eq pt_eq.symm = (stalk_equiv_of_pt_eq pt_eq).symm :=
rfl

lemma stalk_equiv_of_pt_eq.trans (h1 : p.pt = q.pt) (h2 : q.pt = r.pt) :
  stalk_equiv_of_pt_eq (h1.trans h2) =
  (stalk_equiv_of_pt_eq h1).trans (stalk_equiv_of_pt_eq h2) :=
begin
  ext,
  delta stalk_equiv_of_pt_eq,
  simp only [ring_equiv.coe_trans, function.comp_app, CommRing.from_iso_apply,
    ring_equiv.apply_symm_apply, embedding_like.apply_eq_iff_eq],
  obtain ⟨U, hU, s, eq0⟩ := X.presheaf.germ_exist p.pt (p.stalk_iso x),
  rw [←eq0, germ_stalk_specializes'_apply, germ_stalk_specializes'_apply,
    germ_stalk_specializes'_apply],
end

variables (p q r)

structure rel_aux :=
(pt_eq : p.pt = q.pt)
(ring_hom_eq : p.ring_hom_.comp (stalk_equiv_of_pt_eq pt_eq).symm.to_ring_hom
  = q.ring_hom_)

@[simps] def rel_aux_rfl : rel_aux p p :=
{ pt_eq := rfl,
  ring_hom_eq := ring_hom.ext $ λ x,
  begin
    rw [ring_hom.comp_apply],
    erw stalk_equiv_of_pt_eq.rfl_apply x,
  end }

@[simps] def rel_aux_symm (P : rel_aux p q) : rel_aux q p :=
{ pt_eq := P.pt_eq.symm,
  ring_hom_eq := by rw [ring_hom.comp_equiv_to_ring_hom_eq_iff, ←P.ring_hom_eq,
      ←stalk_equiv_of_pt_eq.symm] }

@[simps] def rel_aux_trans (a : rel_aux p q) (b : rel_aux q r) :
  rel_aux p r :=
{ pt_eq := a.pt_eq.trans b.pt_eq,
  ring_hom_eq := by rw [←b.ring_hom_eq, ←a.ring_hom_eq, ring_hom.comp_assoc,
      ←ring_equiv.to_ring_hom_trans, ←ring_equiv.symm_trans,
      stalk_equiv_of_pt_eq.trans] }

def rel : Prop := nonempty $ rel_aux p q

@[refl] lemma rel_refl : rel p p := nonempty.intro $ rel_aux_rfl p
@[symm] lemma rel_symm (h : rel p q) : rel q p :=
nonempty.intro $ rel_aux_symm _ _ h.some
@[trans] lemma rel_trans (h : rel p q) (h' : rel q r) : rel p r :=
nonempty.intro $ rel_aux_trans _ _ _ h.some h'.some

variables (X R)

def setoid_ : setoid (point_local_ring_hom_pair'_aux X R) :=
{ r := rel,
  iseqv := ⟨rel_refl, rel_symm, rel_trans⟩ }

end point_local_ring_hom_pair'_aux

def point_local_ring_hom_pair' : Type (u+1) :=
quotient (point_local_ring_hom_pair'_aux.setoid_ X R)

namespace point_local_ring_hom_pair'

variables {X R} (p q r : point_local_ring_hom_pair' X R)

def pt : X.carrier := p.out'.pt

def stalk_ : Type u := p.out'.stalk_

instance comm_ring_stalk : comm_ring p.stalk_ := p.out'.comm_ring_stalk

def stalk_iso : p.stalk_ ≃+* X.presheaf.stalk p.pt :=
p.out'.stalk_iso

def ring_hom_ : p.stalk_ →+* R :=
p.out'.ring_hom_

instance is_local_ring_hom : is_local_ring_hom p.ring_hom_ :=
p.out'.is_local_ring_hom

lemma mk_pt_eq (x : point_local_ring_hom_pair'_aux X R) :
  pt (quotient.mk' x) = x.pt :=
begin
  obtain ⟨⟨pt_eq, _⟩⟩ := @quotient.mk_out' _ (point_local_ring_hom_pair'_aux.setoid_ X R) x,
  exact pt_eq,
end

@[simps] def mk_stalk_iso (x : point_local_ring_hom_pair'_aux X R) :
  stalk_ (quotient.mk' x) ≃+* x.stalk_ :=
point_local_ring_hom_pair'_aux.stalk_equiv_of_pt_eq $ mk_pt_eq x

lemma mk_stalk_iso.setoid_r {x y : point_local_ring_hom_pair'_aux X R}
  (pt_eq : x.pt = y.pt) :
    (mk_stalk_iso x).trans
      (point_local_ring_hom_pair'_aux.stalk_equiv_of_pt_eq pt_eq)
  = (point_local_ring_hom_pair'_aux.stalk_equiv_of_pt_eq $
      show pt (quotient.mk' x) = pt (quotient.mk' y),
      by rw [mk_pt_eq, mk_pt_eq, pt_eq]).trans
    (mk_stalk_iso y) :=
begin
  ext z : 1,
  dsimp,
  rw [x.stalk_iso.apply_symm_apply, ring_equiv.apply_symm_apply],
  generalize_proofs h1 h2 h3 h4 h5,
  obtain ⟨U, hU, s, eq0⟩ := germ_exist _ _ (((quotient.mk' x).out'.stalk_iso) z),
  rw [←eq0, germ_stalk_specializes'_apply, germ_stalk_specializes'_apply,
    germ_stalk_specializes'_apply, germ_stalk_specializes'_apply],
end

lemma mk_ring_hom_ (x : point_local_ring_hom_pair'_aux X R) :
  ring_hom_ (quotient.mk' x) =
  x.ring_hom_.comp (mk_stalk_iso x).to_ring_hom :=
begin
  obtain ⟨⟨pt_eq, ring_hom_eq⟩⟩ := @quotient.mk_out' _ (point_local_ring_hom_pair'_aux.setoid_ X R) x,
  rw [←ring_hom_eq, ring_hom.comp_assoc],
  symmetry,
  convert ring_hom.comp_id _,
  delta mk_stalk_iso,
  ext : 1,
  erw [ring_equiv.symm_to_ring_hom_apply_to_ring_hom_apply, ring_hom.id_apply],
end

@[simps]
def stalk_iso_of_pt_eq (pt_eq : p.pt = q.pt) :
  p.stalk_ ≃+* q.stalk_ :=
p.stalk_iso.trans $
ring_equiv.trans (CommRing.from_iso
{ hom := X.presheaf.stalk_specializes $ by rw pt_eq,
  inv := X.presheaf.stalk_specializes $ by rw pt_eq,
  hom_inv_id' :=
  begin
    apply stalk_hom_ext,
    intros U hU,
    erw [←category.assoc, germ_stalk_specializes, germ_stalk_specializes,
      category.comp_id],
    refl,
  end,
  inv_hom_id' :=
  begin
    apply stalk_hom_ext,
    intros U hU,
    erw [←category.assoc, germ_stalk_specializes, germ_stalk_specializes,
      category.comp_id],
    refl,
  end }) q.stalk_iso.symm

@[ext] lemma ext (pt_eq : p.pt = q.pt)
  (ring_hom_eq :
      p.ring_hom_.comp (p.stalk_iso_of_pt_eq _ pt_eq).symm.to_ring_hom
    = q.ring_hom_) : p = q :=
begin
  induction p using quotient.induction_on',
  induction q using quotient.induction_on',
  rw quotient.eq',
  have pt_eq' : p.pt = q.pt,
  { rwa [mk_pt_eq, mk_pt_eq] at pt_eq, },
  rw [mk_ring_hom_, mk_ring_hom_] at ring_hom_eq,
  rw [ring_hom.comp_equiv_to_ring_hom_eq_iff, ring_hom.comp_assoc] at
    ring_hom_eq,
  replace ring_hom_eq := ring_hom_eq.symm,
  rw [←ring_hom.comp_equiv_to_ring_hom_eq_iff] at ring_hom_eq,
  refine ⟨⟨pt_eq', _⟩⟩,
  rw [←ring_hom_eq, ring_hom.comp_assoc, ring_hom.comp_assoc],
  convert ring_hom.comp_id _,
  have := congr_arg (λ (r : _ ≃+* _), r.to_ring_hom)
    (mk_stalk_iso.setoid_r pt_eq'),
  dsimp at this,
  erw ←this,
  rw [ring_hom.comp_assoc, ←ring_hom.comp_assoc _ _ (mk_stalk_iso p).to_ring_hom],
  rw show (mk_stalk_iso p).to_ring_hom.comp (mk_stalk_iso p).symm.to_ring_hom
    = ring_hom.id _, from ring_equiv.to_ring_hom_comp_symm_to_ring_hom _,
  rw [ring_hom.id_comp],
  rw ring_equiv.to_ring_hom_comp_symm_to_ring_hom,
end

end point_local_ring_hom_pair'

section

namespace Spec_local_ring_to_Scheme_equiv_point_local_ring_hom_pair_auxs

section affine_cases

variables [is_affine X]

@[simps] def AffineScheme_stalk (x : X.carrier) :
  X.presheaf.stalk x ≅
  CommRing.of (localization.at_prime (X.iso_Spec.hom.1.base x).as_ideal) :=
{ hom := eq_to_hom (by rw [←Scheme.comp_val_base_apply, iso.hom_inv_id,
      Scheme.id_val_base, id_apply]) ≫
    PresheafedSpace.stalk_map X.iso_Spec.inv.1 _ ≫
    (structure_sheaf.stalk_iso _ _).hom,
  inv := (structure_sheaf.stalk_iso _ _).inv ≫
    PresheafedSpace.stalk_map X.iso_Spec.hom.1 _,
  hom_inv_id' :=
  begin
    rw [category.assoc, category.assoc, iso.hom_inv_id_assoc],
    rw [←PresheafedSpace.stalk_map.comp],
    change eq_to_hom _ ≫
      PresheafedSpace.stalk_map ((X.iso_Spec.hom ≫ X.iso_Spec.inv).val) x = _,
    erw ←PresheafedSpace.stalk_map.congr_hom (𝟙 _)
      (X.iso_Spec.hom ≫ X.iso_Spec.inv).val _ x,
    rw PresheafedSpace.stalk_map.id,
    rw iso.hom_inv_id,
    refl,
  end,
  inv_hom_id' :=
  begin
    generalize_proofs h1 h2 h3,
    rw [category.assoc, ←category.assoc _ (eq_to_hom _),
      PresheafedSpace.stalk_map.congr_point, category.assoc,
      ←category.assoc (PresheafedSpace.stalk_map _ _),
      ←PresheafedSpace.stalk_map.comp, ←category.assoc (eq_to_hom _),
      PresheafedSpace.stalk_map.congr_hom
        (X.iso_Spec.inv.val ≫ X.iso_Spec.hom.val) (𝟙 _),
      PresheafedSpace.stalk_map.id, eq_to_hom_trans_assoc, eq_to_hom_refl,
      category.id_comp],
    erw [category.id_comp],
    rw iso.inv_hom_id,
    { change (X.iso_Spec.inv ≫ X.iso_Spec.hom).val = 𝟙 _,
      rw iso.inv_hom_id,
      refl, },
    { rw [←Scheme.comp_val_base_apply, iso.hom_inv_id, Scheme.id_val_base,
        id_apply], },
  end }

@[simps] def point_local_ring_hom_pair_to (P : point_local_ring_hom_pair X R) :
  local_ring.point_local_ring_hom_pair (Γ.obj $ op X) R :=
{ pt := X.iso_Spec.hom.1.base P.pt,
  ring_hom_ := P.ring_hom_.comp $
    (PresheafedSpace.stalk_map X.iso_Spec.hom.1 _).comp $
      structure_sheaf.localization_to_stalk _ _,
  is_local_ring_hom_ := infer_instance }

@[simps] def from_point_local_ring_hom_pair
  (P : local_ring.point_local_ring_hom_pair (Γ.obj $ op X) R) :
  point_local_ring_hom_pair X R :=
{ pt := X.iso_Spec.inv.1.base P.pt,
  ring_hom_ := P.ring_hom_.comp $
    (structure_sheaf.stalk_to_fiber_ring_hom _ _).comp $
    PresheafedSpace.stalk_map X.iso_Spec.inv.1 _,
  is_local_ring_hom := infer_instance }

lemma CommRing_comp_eq_comp {R S T : Type u}
  [comm_ring R] [comm_ring S] [comm_ring T] (f : R →+* S) (g : S →+* T) :
  g.comp f = (show CommRing.of R ⟶ CommRing.of S, from f) ≫
    (show CommRing.of S ⟶ CommRing.of T, from g) :=
rfl

lemma localization.congr_point {R : Type u} [comm_ring R]
  (p q : prime_spectrum R) (h : p = q) (x) :
  (eq_to_hom (by rw h) : CommRing.of (localization.at_prime p.as_ideal) ⟶
    CommRing.of (localization.at_prime q.as_ideal)) x =
  (x.lift_on (λ a b, localization.mk a (⟨b, by { convert b.2, rw h }⟩ :
      q.as_ideal.prime_compl)) $ λ a c b d H,
    begin
      rw localization.r_iff_exists at H,
      obtain ⟨e, he⟩ := H,
      dsimp at he ⊢,
      rw [localization.mk_eq_mk_iff, localization.r_iff_exists],
      refine ⟨⟨e, by { convert e.2, rw h }⟩, _⟩,
      exact he,
    end : localization.at_prime q.as_ideal) :=
begin
  subst h,
  rw eq_to_hom_refl,
  rw id_apply,
  induction x using localization.induction_on with data,
  rcases data with ⟨a, b⟩,
  dsimp,
  rw [localization.lift_on_mk],
  congr' 1,
  ext,
  refl,
end

lemma strucutre_sheaf.localization_to_stalk.congr_point
  (R : Type u) [comm_ring R] (x y : prime_spectrum R) (h : x = y) :
  structure_sheaf.localization_to_stalk R x =
  eq_to_hom (by rw h) ≫ (structure_sheaf.localization_to_stalk R y) ≫
    eq_to_hom (by rw h) :=
begin
  subst h,
  rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id],
end

lemma to_CommRing_of_CommRing (R S : CommRing.{u}) (f : R ⟶ CommRing.of S) :
  f = show R ⟶ S, from f := rfl

lemma CommRing_of_CommRing_eq (R : CommRing.{u}) :
  R = CommRing.of R :=
begin
  obtain ⟨R, str⟩ := R,
  dsimp at *, resetI,
  congr,
end

lemma point_local_ring_hom_pair_to_from (P) :
  point_local_ring_hom_pair_to _ _ (from_point_local_ring_hom_pair X R P) = P :=
local_ring.point_local_ring_hom_pair_ext _ _ _ _
(by { dsimp, rw [←Scheme.comp_val_base_apply, iso.inv_hom_id,
  Scheme.id_val_base, id_apply] }) begin
  obtain ⟨pt, f, h⟩ := P,
  dsimp only [point_local_ring_hom_pair_to_ring_hom_,
    from_point_local_ring_hom_pair_ring_hom_, CommRing_comp_eq_comp,
    from_point_local_ring_hom_pair_pt],
  simp only [category.assoc],
  slice_lhs 3 4
  { erw ←PresheafedSpace.stalk_map.comp X.iso_Spec.inv.1 X.iso_Spec.hom.1 pt },
  rw [PresheafedSpace.stalk_map.congr_hom
    (X.iso_Spec.inv.val ≫ X.iso_Spec.hom.val) (𝟙 _) _ pt,
    PresheafedSpace.stalk_map.id],
  swap,
  { erw [←Scheme.comp_val],
    rw [iso.inv_hom_id],
    refl, },
  erw [category.comp_id],
  have pt_eq : (X.iso_Spec.hom.val.base) ((X.iso_Spec.inv.val.base) pt) = pt,
  { rw [←Scheme.comp_val_base_apply, iso.inv_hom_id, Scheme.id_val_base,
      id_apply] },

  slice_lhs 2 3 { },
  rw strucutre_sheaf.localization_to_stalk.congr_point _ _ pt,
  swap, { exact pt_eq },
  rw [category.assoc, category.assoc],
  erw [category.assoc, category.assoc],
  slice_lhs 4 5 {  },
  erw eq_to_hom_trans,
  swap,
  { rw pt_eq,
    exact CommRing_of_CommRing_eq _, },
  swap,
  { rw pt_eq,
    refl, },
  generalize_proofs h1 h2 h3 h4 h5 h6,
  rw show eq_to_hom h6 =
    𝟙 ((Spec.structure_sheaf (Scheme.Γ.obj (op X))).presheaf.stalk pt), from _,
  swap,
  { convert eq_to_hom_refl _ _, refl, },
  slice_lhs 3 4 { },
  erw show structure_sheaf.localization_to_stalk (Γ.obj (op X)) pt ≫
    𝟙 ((Spec.structure_sheaf (Γ.obj (op X))).presheaf.stalk pt) =
  structure_sheaf.localization_to_stalk (Γ.obj (op X)) pt, from _,
  swap,
  { convert category.comp_id _, },
  erw (structure_sheaf.stalk_iso _ _).inv_hom_id,
  rw [category.id_comp, ←category.assoc],
  convert category.id_comp _,
  { refl, },
  rw [comp_eq_to_hom_iff, category.id_comp],
  apply localization.local_ring_hom_unique,
  intros x,
  rw [localization.congr_point, ←localization.mk_algebra_map,
    algebra.algebra_map_self, localization.lift_on_mk, ring_hom.id_apply,
    ←localization.mk_algebra_map, algebra.algebra_map_self, ring_hom.id_apply],
  refl,

  exact pt_eq.symm,
end

lemma stalk_specializes.congr_point (A : PresheafedSpace CommRing)
  (x y : A) (h : x = y) :
  A.presheaf.stalk_specializes (by rw h : x ⤳ y) = eq_to_hom (by rw h) :=
begin
 subst h,
 apply stalk_hom_ext,
 intros U h,
 erw [eq_to_hom_refl, category.comp_id, germ_stalk_specializes],
 refl,
end

lemma point_local_ring_hom_pair_from_to (P) :
  from_point_local_ring_hom_pair X R (point_local_ring_hom_pair_to _ _ P) = P :=
have pt_eq : (X.iso_Spec.inv.val.base) ((X.iso_Spec.hom.val.base) P.pt) = P.pt,
by rw [←Scheme.comp_val_base_apply, iso.hom_inv_id, Scheme.id_val_base,
  id_apply],
point_local_ring_hom_pair_ext _ _ _ _ pt_eq
begin
  obtain ⟨pt, f, h⟩ := P,
  dsimp only [point_local_ring_hom_pair_to_ring_hom_,
    from_point_local_ring_hom_pair_ring_hom_, CommRing_comp_eq_comp,
    from_point_local_ring_hom_pair_pt],
  simp only [category.assoc],
  erw (structure_sheaf.stalk_iso _ _).hom_inv_id_assoc,
  slice_lhs 2 3 {},
  erw ←PresheafedSpace.stalk_map.comp X.iso_Spec.hom.1 X.iso_Spec.inv.1 pt,
  rw PresheafedSpace.stalk_map.congr_hom
    (X.iso_Spec.hom.val ≫ X.iso_Spec.inv.val) (𝟙 _) _ pt,
  swap,
  { erw [←Scheme.comp_val],
    rw [iso.hom_inv_id],
    refl, },
  rw [PresheafedSpace.stalk_map.id],
  erw [category.comp_id],
  rw [←category.assoc],
  convert category.id_comp _,
  refl,
  generalize_proofs h1 h2 h3,
  rw [show X.presheaf.stalk_specializes h2 = eq_to_hom h3.symm, from _],
  erw [eq_to_hom_trans, eq_to_hom_refl],
  { rw [point_local_ring_hom_pair_to_pt, pt_eq], },
  { rw [point_local_ring_hom_pair_to_pt, pt_eq], },
  rw ←stalk_specializes.congr_point,
  refl,
  erw [id_apply, comp_apply, pt_eq],
end

@[simps] def point_local_ring_hom_pair_equiv :
  point_local_ring_hom_pair X R ≃
  local_ring.point_local_ring_hom_pair (Γ.obj $ op X) R :=
{ to_fun := point_local_ring_hom_pair_to _ _,
  inv_fun := from_point_local_ring_hom_pair _ _,
  left_inv := point_local_ring_hom_pair_from_to _ _,
  right_inv := point_local_ring_hom_pair_to_from _ _ }

instance : local_ring (Γ.obj $ op $ Spec_obj $ CommRing.of R) :=
local_ring.of_equiv _ R $ ring_equiv.symm
{ to_fun := (structure_sheaf.global_sections_iso R).hom,
  inv_fun := (structure_sheaf.global_sections_iso R).inv,
  left_inv := λ x, by rw [iso.hom_inv_id_apply],
  right_inv := λ x, by rw [iso.inv_hom_id_apply],
  map_mul' := map_mul _,
  map_add' := map_add _ }

def Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair :
  ((Spec_obj $ CommRing.of R) ⟶ X) ≃ point_local_ring_hom_pair X R :=
(Scheme.hom.target_AffineScheme _ _).trans $ equiv.trans
  (equiv.trans
    ({ to_fun := λ a, (structure_sheaf.global_sections_iso _).inv.comp a,
      inv_fun := λ a, (structure_sheaf.global_sections_iso _).hom.comp a,
      left_inv := λ a, ring_hom.ext $ λ z,
        by { dsimp only, rw [ring_hom.comp_apply, ring_hom.comp_apply],
          erw (structure_sheaf.global_sections_iso _).inv_hom_id_apply,  },
      right_inv := λ a, ring_hom.ext $ λ z,
        by { dsimp only, rw [ring_hom.comp_apply, ring_hom.comp_apply],
          erw (structure_sheaf.global_sections_iso _).hom_inv_id_apply, } } :
    (Γ.obj (op X) ⟶ Γ.obj (op $ Spec_obj $ CommRing.of R)) ≃
    ((Γ.obj $ op X) →+* R)) $ ring_hom.target_local_ring_equiv _ _)
  (point_local_ring_hom_pair_equiv _ _).symm

instance is_global_section_algebra (pt : prime_spectrum $ Γ.obj $ op X) :
  algebra (Γ.obj $ op X) (X.presheaf.stalk (X.iso_Spec.inv.1.base pt)) :=
ring_hom.to_algebra $ ((stalk_iso_of_affine X pt).symm.to_ring_hom).comp $
  algebra_map _ _

instance is_localization_stalk (pt : prime_spectrum $ Γ.obj $ op X) :
  is_localization pt.as_ideal.prime_compl
    (X.presheaf.stalk $ X.iso_Spec.inv.val.base pt) :=
{ map_units := λ x, begin
    rw ring_hom.algebra_map_to_algebra,
    rw [ring_hom.comp_apply, ←localization.mk_algebra_map, algebra.algebra_map_self,
      ring_hom.id_apply],
    refine is_unit.map _ _,
    rw localization.at_prime.mk_is_unit_iff,
    exact x.2,
  end,
  surj := λ z,
  begin
    simp_rw [ring_hom.algebra_map_to_algebra, ring_hom.comp_apply],
    let z' := stalk_iso_of_affine X pt z,
    obtain ⟨⟨a, b⟩, EQ⟩:= localization.is_localization.surj z',
    rw [←localization.mk_algebra_map, algebra.algebra_map_self, ring_hom.id_apply,
      ←localization.mk_algebra_map] at EQ,
    have eq0 : z = (stalk_iso_of_affine X pt).symm.to_ring_hom z',
    { erw ring_equiv.apply_symm_apply, },
    simp_rw [eq0, ←map_mul, ←localization.mk_algebra_map, algebra.algebra_map_self,
      ring_hom.id_apply],
    refine ⟨⟨a, b⟩, _⟩,
    congr' 1,
  end,
  eq_iff_exists := λ x y,
  begin
    rw [ring_hom.algebra_map_to_algebra, ring_hom.comp_apply,
      ring_hom.comp_apply, function.injective.eq_iff _,
      localization.is_localization.eq_iff_exists],
    rw function.injective_iff_has_left_inverse,
    refine ⟨(stalk_iso_of_affine X pt).to_ring_hom, λ z, _⟩,
    rw [←ring_hom.comp_apply, ring_equiv.to_ring_hom_comp_symm_to_ring_hom,
      ring_hom.id_apply],
  end }

def stalk_iso_is_localization_of_affine'
  (pt : prime_spectrum $ Γ.obj $ op X)
  (M : Type u) [comm_ring M]  [algebra (Γ.obj $ op X) M]
  [by exactI is_localization.at_prime M pt.as_ideal] :
  X.presheaf.stalk (X.iso_Spec.inv.1.base pt) ≃+* M :=
by exactI (is_localization.alg_equiv pt.as_ideal.prime_compl
    (X.presheaf.stalk (X.iso_Spec.inv.1.base pt)) M).to_ring_equiv

namespace Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair'

example (a : local_ring.point_local_ring_hom_pair' (Γ.obj $ op X) R) :
  point_local_ring_hom_pair' X R :=
quotient.map' (λ (P : local_ring.point_local_ring_hom_pair'_aux (Γ.obj $ op X) R),
{ pt := X.iso_Spec.inv.1.base P.pt,
  stalk_ := P.localized_ring,
  comm_ring_stalk := infer_instance,
  stalk_iso := (stalk_iso_is_localization_of_affine' X _ _).symm,
  ring_hom_ := P.ring_hom_,
  is_local_ring_hom := infer_instance })
begin
  rintros P Q ⟨⟨pt_eq, h⟩⟩,
  refine ⟨⟨_, _⟩⟩,
  { dsimp, rw pt_eq, },
  { dsimp, convert h,
    ext z : 1,
    rw point_local_ring_hom_pair'_aux.stalk_equiv_of_pt_eq_apply,
    rw local_ring.point_local_ring_hom_pair'_aux.localized_ring_equiv_of_pt_eq_apply,
    sorry },
end a

example : local_ring.point_local_ring_hom_pair' (Γ.obj $ op X) R
  ≃ point_local_ring_hom_pair' X R :=
{ to_fun := λ a, sorry,
  inv_fun := sorry,
  left_inv := sorry,
  right_inv := sorry }

end Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair'

def Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair' :
  ((Spec_obj $ CommRing.of R) ⟶ X) ≃ point_local_ring_hom_pair' X R :=
(Scheme.hom.target_AffineScheme _ _).trans $
  equiv.trans
    ({ to_fun := λ f, f ≫ (structure_sheaf.global_sections_iso _).inv,
      inv_fun := λ f, (structure_sheaf.global_sections_iso _).hom.comp f,
      left_inv := λ f,
      begin
        simp_rw [CommRing_comp_eq_comp],
        erw [category.assoc, iso.inv_hom_id, category.comp_id],
      end,
      right_inv := λ f,
      begin
        simp_rw [CommRing_comp_eq_comp],
        erw [category.assoc, iso.hom_inv_id, category.comp_id],
      end } : (Γ.obj (op X) ⟶ Γ.obj (op (Spec_obj (CommRing.of R)))) ≃
      ((Γ.obj $ op X) →+* R)) $
    equiv.trans
      (ring_hom.target_local_ring_equiv' R (Γ.obj $ op X)) $
      sorry

namespace Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair

lemma apply_pt (α : (Spec_obj $ CommRing.of R) ⟶ X) :
  (Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair X R α).pt =
  X.iso_Spec.inv.1.base
    ⟨ideal.comap ((structure_sheaf.global_sections_iso R).inv.comp $
      Scheme.hom.target_AffineScheme (Spec_obj $ CommRing.of R) X α) $
      local_ring.maximal_ideal R, infer_instance⟩ :=
begin
  dsimp only [Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair],
  rw [equiv.trans_apply, equiv.trans_apply,
    point_local_ring_hom_pair_equiv_symm_apply,
    from_point_local_ring_hom_pair_pt, equiv.trans_apply, equiv.coe_fn_mk],
  congr' 1,
end

lemma apply_ring_hom__apply (α : (Spec_obj $ CommRing.of R) ⟶ X) :
  (Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair
    X R α).ring_hom_ =
  ((((inv (structure_sheaf.to_open R ⊤) : _ →+* _).comp $
      Scheme.hom.target_AffineScheme (Spec_obj $ CommRing.of R) X
        α).factor_through_target_local_ring).comp $
     (structure_sheaf.stalk_iso (Γ.obj $ op X)
        ⟨(local_ring.maximal_ideal R).comap _, _⟩).hom).comp
  (PresheafedSpace.stalk_map X.iso_Spec.inv.1 _) :=
begin
  dsimp only [Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair,
    equiv.trans_apply, point_local_ring_hom_pair_equiv_symm_apply,
    from_point_local_ring_hom_pair_ring_hom_, structure_sheaf.stalk_iso_hom,
    ring_hom.target_local_ring_equiv, equiv.coe_fn_mk],
  simp only [CommRing_comp_eq_comp, category.assoc],
  congr' 1,
end

lemma symm_apply (P : point_local_ring_hom_pair X R) :
  (Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair X R).symm P =
  (Scheme.hom.target_AffineScheme (Spec_obj $ CommRing.of R) X).symm
    ((structure_sheaf.to_open ↥(CommRing.of R) ⊤ : _ →+* _).comp $
      (P.ring_hom_.comp $
        (PresheafedSpace.stalk_map X.iso_Spec.hom.1 P.pt : _ →+* _).comp
          (structure_sheaf.localization_to_stalk (Γ.obj $ op X) $
            X.iso_Spec.hom.val.base P.pt)).comp $
        @@algebra_map (Scheme.Γ.obj (op X))
          (localization.at_prime $ (X.iso_Spec.hom.1.base P.pt).as_ideal) _ _ $
            by {dsimp, exactI localization.algebra}) :=
rfl

end Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair

end affine_cases

section nonaffine_cases

instance spec_is_affine (S : Type u) [comm_ring S] :
  is_affine $ Spec_obj (CommRing.of S) :=
algebraic_geometry.Spec_is_affine (op _)

instance spec_is_affine' (S : CommRing) : is_affine $ Spec_obj S :=
algebraic_geometry.Spec_is_affine (op _)

variables {X R}

section basic_defs
variable (P : point_local_ring_hom_pair X R)
variables {U : opens X.carrier} (hU : is_affine_open U) (mem_U : P.pt ∈ U)

def _root_.algebraic_geometry.is_affine_open.iso_Spec :
  X.restrict U.open_embedding ≅
  Spec_obj (X.presheaf.obj $ op U) :=
@Scheme.iso_Spec _ hU ≪≫ eq_to_iso
begin
  dsimp, congr', ext y, split,
  { rintros ⟨y, _, rfl⟩, exact y.2 },
  { intros hy, exact ⟨⟨y, hy⟩, ⟨⟩, rfl⟩, }
end

def _root_.algebraic_geometry.is_affine_open.pt_in_restricted_global_sections
  {x : X.carrier} (hx : x ∈ U) : (Spec_obj $ X.presheaf.obj $ op U).carrier :=
hU.iso_Spec.hom.1.base ⟨x, hx⟩

def stalk_on_open_equiv (x : X.carrier) (hx : x ∈ U) :
  X.presheaf.stalk x ≅ (X.restrict U.open_embedding).presheaf.stalk ⟨x, hx⟩ :=
iso.symm $ PresheafedSpace.restrict_stalk_iso X.to_PresheafedSpace _ _

def _root_.algebraic_geometry.is_affine_open.point_local_ring_hom_pair :
  point_local_ring_hom_pair (Spec_obj $ X.presheaf.obj $ op U) R :=
{ pt := hU.iso_Spec.hom.1 ⟨P.pt, mem_U⟩,
  ring_hom_ := P.ring_hom_.comp $
    (X.to_PresheafedSpace.restrict_stalk_iso U.open_embedding
      ⟨P.pt, mem_U⟩).hom.comp $ PresheafedSpace.stalk_map hU.iso_Spec.hom.1 _,
  is_local_ring_hom := infer_instance }

def _root_.algebraic_geometry.is_affine_open.Spec_local_ring_to_Scheme :
  Spec_obj (CommRing.of R) ⟶ X :=
(Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair _ R).symm
  (hU.point_local_ring_hom_pair P mem_U) ≫ hU.from_Spec

end basic_defs

section independence

variable (P : point_local_ring_hom_pair X R)
variables {U : opens X.carrier} (hU : is_affine_open U) (mem_U : P.pt ∈ U)
variables {V : opens X.carrier} (hV : is_affine_open V) (mem_V : P.pt ∈ V)

namespace Spec_local_ring_to_Scheme_wd_proofs

def ψ_ :
  (X.restrict U.open_embedding).presheaf.stalk ⟨P.pt, mem_U⟩ →+* R :=
P.ring_hom_.comp
  (PresheafedSpace.restrict_stalk_iso _ U.open_embedding _).hom

instance is_local_ring_hom_ψ_ : is_local_ring_hom (ψ_ P mem_U) :=
by { delta ψ_, apply_instance }

def ψ'_ :
  localization.at_prime
    (((@Scheme.iso_Spec _ hU).hom.1.base ⟨P.pt, mem_U⟩).as_ideal :
      ideal $ Γ.obj $ op $ X.restrict U.open_embedding) →+* R :=
(ψ_ P mem_U).comp $
  ((PresheafedSpace.stalk_map (@Scheme.iso_Spec _ hU).hom.1) _).comp
    (structure_sheaf.stalk_iso _ _).inv

def ψ''_ : (Γ.obj $ op $ X.restrict U.open_embedding) →+* R :=
(ψ'_ P hU mem_U).comp $ @algebra_map _ _ _ _ $
  by { dsimp, exactI localization.algebra }

def res'_aux (subset_rel : U ⊆ V) :
  U.open_embedding.is_open_map.functor.obj ⊤ ⟶
  V.open_embedding.is_open_map.functor.obj ⊤ :=
hom_of_le
begin
  convert subset_rel;
  { ext p, split,
    { rintros ⟨p, _, rfl⟩, exact p.2 },
    { intro h, refine ⟨⟨p, h⟩, ⟨⟩, rfl⟩, } }
end

def res'_ (subset_rel : U ⊆ V) :
  localization.at_prime
    (((@Scheme.iso_Spec _ hV).hom.1.base ⟨P.pt, mem_V⟩).as_ideal :
      ideal $ Γ.obj $ op $ X.restrict V.open_embedding) →+*
  localization.at_prime
    (((@Scheme.iso_Spec _ hU).hom.1.base ⟨P.pt, mem_U⟩).as_ideal :
      ideal $ Γ.obj $ op $ X.restrict U.open_embedding) :=
localization.local_ring_hom _ _
  (X.presheaf.map $ (res'_aux subset_rel).op) -- Γ.map (quiver.hom.op (X.restrict_functor.map $ hom_of_le subset_rel).left)
begin
  haveI : is_affine (X.restrict V.open_embedding) := hV,
  haveI : is_affine (X.restrict U.open_embedding) := hU,
  rw [←prime_spectrum.comap_as_ideal],
  refine congr_arg _ _,
  -- ext1 (x : X.presheaf.obj _),
  -- rw ideal.mem_comap,
  -- have := Scheme.mem_basic_open,
  -- have := (X.restrict V.open_embedding).iso_Spec,
  -- rw Scheme.mem_iso_Spec_inv_apply,
  -- erw Scheme.mem_iso_Spec_inv_apply,
  -- refine iff.not _,
  -- rw [←basic_open_eq_of_affine],
  -- conv_rhs { rw [←basic_open_eq_of_affine] },
  -- rw [Scheme.mem_basic_open],

  dsimp only [Scheme.iso_Spec],
  simp only [Γ_Spec.adjunction_unit_app, as_iso_hom],
  dsimp only [Γ_Spec.LocallyRingedSpace_adjunction, identity_to_Γ_Spec,
    adjunction.mk_of_unit_counit_unit, LocallyRingedSpace.to_Γ_Spec,
    LocallyRingedSpace.to_Γ_Spec_SheafedSpace, continuous_map.coe_mk,
    LocallyRingedSpace.to_Γ_Spec_base, LocallyRingedSpace.to_Γ_Spec_fun,
    local_ring.closed_point],
  rw [←prime_spectrum.comap_comp_apply],
  ext : 1,
  change prime_spectrum.as_ideal _ = prime_spectrum.as_ideal _,
  ext x : 1,
  rw [prime_spectrum.comap_as_ideal, prime_spectrum.comap_as_ideal,
    ideal.mem_comap, ideal.mem_comap, local_ring.mem_maximal_ideal,
    local_ring.mem_maximal_ideal, mem_nonunits_iff, mem_nonunits_iff],
  refine iff.not _,
  split,
  { introsI H,
    let iV := X.restrict_stalk_iso V.open_embedding ⟨P.pt, mem_V⟩,
    let iU := X.restrict_stalk_iso U.open_embedding ⟨P.pt, mem_U⟩,
    refine ⟨⟨iU.inv $ iV.hom H.unit.1, iU.inv $ iV.hom $ H.unit⁻¹.1, _, _⟩, _⟩,
    { rw [←map_mul, ←map_mul, units.val_eq_coe, units.val_eq_coe,
        is_unit.mul_coe_inv, map_one, map_one], },
    { erw [←map_mul, ←map_mul, units.val_eq_coe, units.val_eq_coe,
        is_unit.coe_inv_mul, map_one, map_one], },
    { rw [units.coe_mk],
      sorry }, },
  sorry,
end

lemma triangle_commutes (subset_rel : U ⊆ V) :
  (ψ'_ P hU mem_U).comp (res'_ P hU mem_U hV mem_V subset_rel) =
  ψ'_ P hV mem_V :=
sorry

@[simps] def point_local_ring_hom_pair_ :
  point_local_ring_hom_pair (X.restrict U.open_embedding) R :=
{ pt := ⟨P.pt, mem_U⟩,
  ring_hom_ := ψ_ _ _,
  is_local_ring_hom := infer_instance }

def Ψ'_ : Spec_obj (CommRing.of R) ⟶ X.restrict U.open_embedding :=
(@@Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair
    (X.restrict U.open_embedding) R _ _ hU).symm
  (point_local_ring_hom_pair_ P mem_U)

lemma Ψ'_eq_of_subset_rel (subset_rel : U ⊆ V) :
  Ψ'_ P hU mem_U ≫
    ((X.restrict_functor).map (hom_of_le subset_rel)).left =
  Ψ'_ P hV mem_V :=
begin
  haveI : is_affine (X.restrict_functor.obj V).left := hV,
  haveI : is_affine (X.restrict V.open_embedding) := hV,
  apply_fun (Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair _ R),
  dsimp only [Ψ'_],
  generalize_proofs h1 h2 h3 h4,
  dsimp only [Scheme.restrict_functor_obj_left,
    Scheme.restrict_functor_map_left],
  work_on_goal 2 { apply_instance },
  rw (Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair
    (X.restrict h2) R).apply_symm_apply (point_local_ring_hom_pair_ P mem_V),
  sorry
end

def Ψ_ : Spec_obj (CommRing.of R) ⟶ X :=
  Ψ'_ P hU mem_U ≫ X.of_restrict _

lemma _root_.algebraic_geometry.is_affine_open.Spec_local_ring_to_Scheme_eq :
  hU.Spec_local_ring_to_Scheme P mem_U = Ψ_ P hU mem_U := sorry

lemma _root_.algebraic_geometry.is_affine_open.Spec_local_ring_to_Scheme_wd_of_subset_rel
  (subset_rel : U ⊆ V) :
  hU.Spec_local_ring_to_Scheme P mem_U = hV.Spec_local_ring_to_Scheme P mem_V :=
begin
  rw [hU.Spec_local_ring_to_Scheme_eq P mem_U,
    hV.Spec_local_ring_to_Scheme_eq P mem_V, Ψ_, Ψ_,
    ←Ψ'_eq_of_subset_rel P hU mem_U hV mem_V subset_rel, category.assoc],
  congr' 1,
  dsimp,
  rw is_open_immersion.lift_fac,
end

end Spec_local_ring_to_Scheme_wd_proofs

-- this is probably going to be long
lemma _root_.algebraic_geometry.is_affine_open.Spec_local_ring_to_Scheme_wd :
  hU.Spec_local_ring_to_Scheme P mem_U = hV.Spec_local_ring_to_Scheme P mem_V :=
sorry

section

variables (X)

def _root_.algebraic_geometry.Scheme.open_set_of (x : X.carrier) :
  opens X.carrier := (X.local_affine x).some.1

lemma _root_.algebraic_geometry.Scheme.mem_open_set_of (x : X.carrier) :
  x ∈ X.open_set_of x :=
(X.local_affine x).some.2

def _root_.algebraic_geometry.Scheme.CommRing_of (x : X.carrier) :
  CommRing.{u} := (X.local_affine x).some_spec.some

def _root_.algebraic_geometry.Scheme.iso_Spec_of (x : X.carrier) :
  X.restrict (X.open_set_of x).open_embedding ≅
  Spec_obj (X.CommRing_of x) :=
let α : X.to_LocallyRingedSpace.restrict (X.open_set_of x).open_embedding ≅
    Spec.to_LocallyRingedSpace.obj (op $ X.CommRing_of x) :=
  (X.local_affine x).some_spec.some_spec.some in
{ hom := α.hom,
  inv := α.inv,
  hom_inv_id' := α.hom_inv_id,
  inv_hom_id' := α.inv_hom_id }

lemma _root_.algebraic_geometry.Scheme.is_affine_open_set_of (x : X.carrier) :
  is_affine_open $ X.open_set_of x :=
is_affine_of_iso (X.iso_Spec_of x).hom

end

def Spec_local_ring_to_Scheme : Spec_obj (CommRing.of R) ⟶ X :=
(X.is_affine_open_set_of P.pt).Spec_local_ring_to_Scheme P $
  X.mem_open_set_of P.pt

end independence

section basic_defs

variables (α : Spec_obj (CommRing.of R) ⟶ X)
variables {V : opens X.carrier} (hV : is_affine_open V)
variables
  (image_mem : α.1.base ⟨local_ring.maximal_ideal _, infer_instance⟩ ∈ V)

section

variables (X)

lemma _root_.algebraic_geometry.Scheme.range_of_restrict :
  set.range (X.of_restrict V.open_embedding).1.base = (V : set X.carrier) :=
set.ext_iff.mpr $ λ x,
{ mp := by { rintros ⟨x, rfl⟩, exact x.2, },
  mpr := by { intros h, refine ⟨⟨x, h⟩, rfl⟩ } }

end

section

include image_mem

lemma image_subset_of_image_mem :
  set.range α.1.base ⊆ set.range (X.of_restrict V.open_embedding).1.base :=
begin
  rw X.range_of_restrict, rintros _ ⟨x, rfl⟩,
  refine specializes.mem_open (specializes.map _ (by continuity)) V.2 image_mem,
  rw ←prime_spectrum.le_iff_specializes,
  change x.as_ideal ≤ local_ring.maximal_ideal R,
  refine local_ring.le_maximal_ideal (ideal.is_prime.ne_top infer_instance),
end

end

def Spec_local_ring_to_Scheme_factors_through_of_image_mem :
  Spec_obj (CommRing.of R) ⟶ X.restrict V.open_embedding :=
LocallyRingedSpace.is_open_immersion.lift (X.of_restrict V.open_embedding) α $
image_subset_of_image_mem _ image_mem

def to_point_local_ring_hom_pair_of_image_mem_affine_open_aux :
  point_local_ring_hom_pair (X.restrict $ V.open_embedding) R :=
(@@Spec_local_ring_to_AffineScheme_equiv_point_local_ring_hom_pair _ _ _ _ hV) $
  Spec_local_ring_to_Scheme_factors_through_of_image_mem α image_mem

def to_point_local_ring_hom_pair_of_image_mem_affine_open :
  point_local_ring_hom_pair X R :=
let P := to_point_local_ring_hom_pair_of_image_mem_affine_open_aux
  α hV image_mem in
{ pt := P.pt.1,
  ring_hom_ := P.ring_hom_.comp
    (PresheafedSpace.restrict_stalk_iso _ V.open_embedding P.pt).inv,
  is_local_ring_hom := infer_instance }

end basic_defs

section independence

variables (α : Spec_obj (CommRing.of R) ⟶ X)
variables {V₁ V₂ : opens X.carrier}
variables (hV₁ : is_affine_open V₁) (hV₂ : is_affine_open V₂)
variables
  (image_mem₁ : α.1.base ⟨local_ring.maximal_ideal _, infer_instance⟩ ∈ V₁)
variables
  (image_mem₂ : α.1.base ⟨local_ring.maximal_ideal _, infer_instance⟩ ∈ V₂)

lemma to_point_local_ring_hom_of_image_mem_affine_open_wd :
  to_point_local_ring_hom_pair_of_image_mem_affine_open α hV₁ image_mem₁ =
  to_point_local_ring_hom_pair_of_image_mem_affine_open α hV₂ image_mem₂ :=
sorry

end independence

def to_point_local_ring_hom_pair (α : Spec_obj (CommRing.of R) ⟶ X) :
  point_local_ring_hom_pair X R :=
to_point_local_ring_hom_pair_of_image_mem_affine_open α
  (X.is_affine_open_set_of
    (α.1.base ⟨local_ring.maximal_ideal _, infer_instance⟩)) $
  X.mem_open_set_of _

end nonaffine_cases

end Spec_local_ring_to_Scheme_equiv_point_local_ring_hom_pair_auxs

section

open Spec_local_ring_to_Scheme_equiv_point_local_ring_hom_pair_auxs

-- 01J6
def Spec_local_ring_to_Scheme_equiv_point_local_ring_pair :
  ((Spec_obj $ CommRing.of R) ⟶ X) ≃ point_local_ring_hom_pair X R :=
{ to_fun := to_point_local_ring_hom_pair,
  inv_fun := Spec_local_ring_to_Scheme,
  left_inv := sorry,
  right_inv := sorry }

end

end

variables {X R}

-- 02NA
def Spec_stalk_to_Scheme (x : X.carrier) :
  Spec_obj (X.presheaf.stalk x) ⟶ X :=
(Spec_local_ring_to_Scheme_equiv_point_local_ring_pair X _).symm
{ pt := x,
  ring_hom_ := ring_hom.id _,
  is_local_ring_hom := infer_instance }

end algebraic_geometry


import deduction semantics lindenbaum
open encodable

namespace fopl
variables {L : language.{0}}

local infix ` ≃₁ `:80 := ((≃) : term L → term L → formula L)
local prefix `∏₁ `:64 := (has_univ_quantifier.univ : formula L → formula L)
local prefix `∐₁ `:64 := (has_exists_quantifier.ex : formula L → formula L)

variables [decidable_eq (formula L)]

@[simp] def formula.arrow : formula L → option (formula L × formula L)
| (p ⟶ q) := some (p, q)
| _        := none

lemma arrow_eq {p : formula L} {v} : p.arrow = some v → p = v.1 ⟶ v.2 :=
by { cases p; simp[show ∀ x y : term L, (x ≃ y : formula L).arrow = none, from λ _ _, rfl,
      show ∀ p : formula L, (⁻p).arrow = none, from λ _, rfl,
      show ∀ p : formula L, (∏ p : formula L).arrow = none, from λ _, rfl], intros h, simp[←h] }

inductive proof (L : language.{0}) : Type
| root : formula L → proof
| ge : proof → proof
| mp : proof → proof → proof

@[simp] def proof.conseq : proof L → option (formula L)
| (proof.root p) := some p
| (proof.ge φ)   := φ.conseq.map (λ p, ∏ p)
| (proof.mp φ ψ) :=
    if (φ.conseq >>= formula.arrow).map prod.fst = ψ.conseq then (φ.conseq >>= formula.arrow).map prod.snd
    else ψ.conseq

inductive formula.is_axiom (T : theory L) (i : ℕ) : formula L → Prop
| p1 {p q} : formula.is_axiom (p ⟶ q ⟶ p)
| p2 {p q r} : formula.is_axiom ((p ⟶ q ⟶ r) ⟶ (p ⟶ q) ⟶ p ⟶ r)
| p3 {p q} : formula.is_axiom ((⁻p ⟶ ⁻q) ⟶ q ⟶ p)
| q1 {p t} : formula.is_axiom (∏₁ p ⟶ p.rew ι[0 ⇝ t])
| q2 {p q} : formula.is_axiom (∏₁ (p ⟶ q) ⟶ ∏₁ p ⟶ ∏₁ q)
| q3 {p} : formula.is_axiom (p ⟶ ∏₁ (p^1))
| e1 : formula.is_axiom ∏₁ #0 ≃₁ #0
| e2 : formula.is_axiom ∏₁ ∏₁ (#0 ≃₁ #1 ⟶ #1 ≃₁ #0)
| e3 : formula.is_axiom ∏₁ ∏₁ ∏₁ (#0 ≃₁ #1 ⟶ #1 ≃₁ #2 ⟶ #0 ≃₁ #2)
| e4 {n} {f : L.fn n} : formula.is_axiom (eq_axiom4 f)
| e5 {n} {r : L.pr n} : formula.is_axiom (eq_axiom5 r)
| by_axiom {p} : p ∈ T^i → formula.is_axiom p

@[simp] def proof.proper (T : theory L) : ℕ → proof L → Prop
| i (proof.root p) := p.is_axiom T i
| i (proof.ge φ)   := φ.proper (i + 1)
| i (proof.mp φ ψ) := (φ.proper i) ∧ (ψ.proper i)

def proof.of (T : theory L) (i : ℕ) (p : formula L) (φ : proof L) : Prop := φ.proper T i ∧ φ.conseq = some p

namespace proof
open nat
variables {T : theory L} {i : ℕ}

lemma provable_of_is_axiom {p} (h : is_axiom T i p) : T^i ⊢ p :=
begin
  cases h; try {simp}, { exact provable.e4 }, { exact provable.e5 },
  { exact provable.AX (by simp*) }
end

lemma sound {T : theory L} {i} {p} {φ} : proof.of T i p φ → T^i ⊢ p :=
begin
  induction φ generalizing p i; simp[proof.of],
  case root : i p { rintros h rfl, exact provable_of_is_axiom h },
  case ge : φ IH p { rintros proper q conseq rfl, exact provable.generalize (IH ⟨proper, conseq⟩) },
  case mp : φ ψ IHφ IHψ
    { cases φ_conseq : φ.conseq with cφ; cases ψ_conseq : ψ.conseq with cψ; simp[φ_conseq, ψ_conseq],
      { rintros pφ pψ rfl, exact IHψ ⟨pψ, ψ_conseq⟩ },
      { intros pφ pψ, simp[show (∀ (a b a_1 : formula L), cφ = a_1 → ¬a_1.arrow = some (a, b)) ↔ cφ.arrow = none,
          from ⟨λ h, by { cases C : cφ.arrow with v; simp, exact h v.1 v.2 cφ rfl (by simp[C]) },
           by { rintros h a b _ rfl, simp[h] }⟩],
        cases C : cφ.arrow with v; simp[C] },
      { rintros pφ pψ, cases C : cφ.arrow with v; simp, { rintros rfl, exact IHψ ⟨pψ, ψ_conseq⟩ },
        { by_cases C₂ : v.1 = cψ,
          { simp[←C₂, show ∃ a, v = (v.fst, a), from ⟨v.2, by simp⟩],
            rintros rfl, rcases C₂ with rfl, rcases arrow_eq C with rfl,
            exact classical_logic.modus_ponens (IHφ ⟨pφ, φ_conseq⟩) (IHψ ⟨pψ, ψ_conseq⟩) },
          { simp[show ¬∃ (a : formula L), v = (cψ, a), by { simp, rintros s rfl, simp at C₂, contradiction }],
            rintros rfl, exact IHψ ⟨pψ, ψ_conseq⟩ } } } }
end

lemma complete {T : theory L} {i} (p : formula L) : T^i ⊢ p ↔ ∃ φ, of T i p φ :=
⟨λ h,
begin
  apply fopl.provable.rec_on' h,
  { rintros i p _ ⟨φ, φ_proper, φ_conseq⟩, refine ⟨φ.ge, _, _⟩; simp* },
  { rintros i p q _ _ ⟨φ, φ_proper, φ_conseq⟩ ⟨ψ, ψ_proper, ψ_conseq⟩,
    refine ⟨φ.mp ψ, _, _⟩; simp[*, (>>=)] },
  { intros i p _, refine ⟨root p, _, _⟩; simp, exact formula.is_axiom.by_axiom mem },
  { intros i p q, refine ⟨root (p ⟶ q ⟶ p), _, _⟩; simp, exact formula.is_axiom.p1 },
  { intros i p q r, refine ⟨root ((p ⟶ q ⟶ r) ⟶ (p ⟶ q) ⟶ p ⟶ r), _, _⟩; simp, exact formula.is_axiom.p2 },
  { intros i p q, refine ⟨root ((⁻p ⟶ ⁻q) ⟶ q ⟶ p), _, _⟩; simp, exact formula.is_axiom.p3 },
  { intros i p t, refine ⟨root (∏ p ⟶ formula.rew ι[0 ⇝ t] p), _, _⟩; simp, exact formula.is_axiom.q1 },
  { intros i p q, refine ⟨root (∏ (p ⟶ q) ⟶ ∏ p ⟶ ∏ q), _, _⟩; simp, exact formula.is_axiom.q2 },
  { intros i p, refine ⟨root (p ⟶ ∏ p ^ 1), _, _⟩; simp, exact formula.is_axiom.q3 },
  { intros i, refine ⟨root (∏₁ #0 ≃₁ #0), _, _⟩; simp, exact formula.is_axiom.e1 },
  { intros i, refine ⟨root (∏₁ ∏₁ (#0 ≃₁ #1 ⟶ #1 ≃₁ #0)), _, _⟩; simp, exact formula.is_axiom.e2 },
  { intros i, refine ⟨root (∏₁ ∏₁ ∏₁ (#0 ≃₁ #1 ⟶ #1 ≃₁ #2 ⟶ #0 ≃₁ #2)), _, _⟩; simp, exact formula.is_axiom.e3 },
  { intros i m f, refine ⟨root (eq_axiom4 f), _, _⟩; simp, exact formula.is_axiom.e4 },
  { intros i m p, refine ⟨root (eq_axiom5 p), _, _⟩; simp, exact formula.is_axiom.e5 }
end, λ ⟨φ, h⟩, sound h⟩

variables [primcodable (formula L)]

@[simp] def encode_pcode : proof L → ℕ
| (root p) := (bit0 $ encode p) + 1
| (ge φ)   := (bit1 $ bit0 $ encode_pcode φ) + 1
| (mp φ ψ) := (bit1 $ bit1 $ nat.mkpair (encode_pcode φ) (encode_pcode ψ)) + 1

@[simp] def decode_pcode : ℕ → option (proof L)
| 0       := none
| (n + 1) :=
    have div4 : n.div2.div2 ≤ n :=
      by { simp[nat.div2_val], exact le_trans (nat.div_le_self (n / 2) 2) (nat.div_le_self n 2) },
    have n.div2.div2 < n + 1, from nat.lt_succ_iff.mpr div4,
    have n.div2.div2.unpair.1 < n + 1,
      from nat.lt_succ_iff.mpr (le_trans (nat.unpair_left_le n.div2.div2) div4),
    have n.div2.div2.unpair.2 < n + 1,
      from nat.lt_succ_iff.mpr (le_trans (nat.unpair_right_le n.div2.div2) div4),
    match n.bodd, n.div2.bodd with
    | ff, _  := (decode (formula L) n.div2).map root
    | tt, ff := (decode_pcode n.div2.div2).map proof.ge
    | tt, tt := proof.mp <$> (decode_pcode n.div2.div2.unpair.1) <*> (decode_pcode n.div2.div2.unpair.2)
    end

instance : encodable (proof L) :=
{ encode := encode_pcode,
  decode := decode_pcode,
  encodek := by { intros φ, induction φ; simp[encode_pcode, decode_pcode, *] } }

noncomputable def of_n (T : theory L) (p : ℕ) (s : ℕ) : ℕ :=
  encode
  ( do p ← decode (formula L) p,
       φ ← decode (proof L) s,
    some (to_bool (proof.of T 0 p φ)))

lemma of_n_complete (p : formula L) :
  T ⊢ p ↔ ∃ s, of_n T (encode p) s = encode (some tt) :=
by { have : T ⊢ p ↔ ∃ φ, of T 0 p φ, rw[show T = T^0, by simp], from complete p,
     simp[this, of_n],
     split,
     { rintros ⟨φ, of⟩, refine ⟨encode φ, _⟩, simp[of] },
     { rintros ⟨s, of⟩, cases C : decode (proof L) s with φ; simp[C] at of,
       { contradiction },
       { refine ⟨φ, _⟩, by_cases C₂ : fopl.proof.of T 0 p φ; simp[C₂] at of ⊢, { contradiction } } } }

end proof

variables [primcodable (formula L)] [primcodable (proof L)]

class primrec_theory (T : theory L) :=
(prim : primrec₂ (λ p φ, proof.of_n T p φ))

variables {T : theory L} [primrec_theory T]

#eval encode (some tt)

end fopl


import algebra.group.defs
import algebra.module.basic

import expr

namespace quantitative_types
section

open mult
open ctx

def mult.add : mult → mult → mult
| error _     := error
| _     error := error
| none  π     := π
| π     none  := π
| _     all   := error
| all   _     := error
| _     init  := error
| free  _     := error
| init  free  := all
| init  _     := init
| _     free  := free
| read  read  := read
| read  write := write
| write read  := write
| write write := write

/-
def mult.mul : mult → mult → mult
| 0 _ := 0
| 1 a := a
| ω 0 := 0
| ω _ := ω
-/

instance : has_add mult := ⟨mult.add⟩
-- instance : has_mul mult := ⟨mult.mul⟩

@[simp] lemma mult.add_zero (a : mult) : a + 0 = a := by { cases a; refl }
@[simp] lemma mult.zero_add (a : mult) : 0 + a = a := by { cases a; refl }
lemma mult.add_assoc (a b c : mult) : (a + b) + c = a + (b + c) := by { cases a; cases b; cases c; refl }
-- lemma mult.add_comm (a b : mult) : a + b = b + a := by { cases a; cases b; refl }

/-
@[simp] lemma mult.mul_zero (a : mult) : a * 0 = 0 := by { cases a; refl }
@[simp] lemma mult.zero_mul (a : mult) : 0 * a = 0 := by { cases a; refl }
@[simp] lemma mult.mul_one (a : mult) : a * 1 = a := by { cases a; refl }
@[simp] lemma mult.one_mul (a : mult) : 1 * a = a := by { cases a; refl }
lemma mult.mul_assoc (a b c : mult) : (a * b) * c = a * (b * c) := by { cases a; cases b; cases c; refl }
lemma mult.left_distrib (a b c : mult) : a * (b + c) = a * b + a * c := by { cases a; cases b; cases c; refl }
lemma mult.right_distrib (a b c : mult) : (a + b) * c = a * c + b * c := by { cases a; cases b; cases c; refl }

instance : semiring mult :=
{ zero := mult.zero,
  one := mult.one,
  add := mult.add,
  mul := mult.mul,
  zero_add := mult.zero_add,
  add_zero := mult.add_zero,
  add_assoc := mult.add_assoc,
  add_comm := mult.add_comm,
  mul_zero := mult.mul_zero,
  zero_mul := mult.zero_mul,
  mul_one := mult.mul_one,
  one_mul := mult.one_mul,
  mul_assoc := mult.mul_assoc,
  left_distrib := mult.left_distrib,
  right_distrib := mult.right_distrib }
-/

instance : add_monoid mult :=
{ zero := mult.none,
  add := mult.add,
  zero_add := mult.zero_add,
  add_zero := mult.add_zero,
  add_assoc := mult.add_assoc }

def ctx.length : Π {γ : ctype}, ctx γ → nat
| γ _ := γ.length

def ctx.nth : Π {γ : ctype}, ctx γ → nat → option (mult × expr)
| []       nil          _       := option.none
| (t :: γ) (cons π _ Γ) 0       := option.some (π, t)
| (t :: γ) (cons π _ Γ) (n + 1) := ctx.nth Γ n

def ctx.zero : Π {γ : ctype}, ctx γ
| []       := nil
| (t :: γ) := cons 0 t ctx.zero

/-
def ctx.one : Π {γ : ctype}, ctx γ
| []       := nil
| (t :: γ) := cons 1 t ctx.one
-/

def ctx.add : Π {γ : ctype}, ctx γ → ctx γ → ctx γ
| []       nil            nil            := nil
| (t :: γ) (cons π₁ _ Γ₁) (cons π₂ _ Γ₂) := cons (π₁ + π₂) t (ctx.add Γ₁ Γ₂)

/-
def ctx.smul : Π {γ : ctype}, mult → ctx γ → ctx γ
| []       _  nil          := nil
| (t :: γ) π' (cons π _ Γ) := cons (π' * π) t (ctx.smul π' Γ)
-/

instance {γ : ctype} : has_zero (ctx γ) := ⟨ctx.zero⟩
-- instance {γ : ctype} : has_one (ctx γ) := ⟨ctx.one⟩
instance {γ : ctype} : has_add (ctx γ) := ⟨ctx.add⟩
-- instance {γ : ctype} : has_smul mult (ctx γ) := ⟨ctx.smul⟩

@[simp] lemma ctx.zero_cons {γ : ctype} {t : expr} : (0 : ctx (t :: γ)) = (⟦0 • t⟧ :: (0 : ctx γ)) := rfl
-- @[simp] lemma ctx.one_cons {γ : ctype} {t : expr} : (1 : ctx (t :: γ)) = (⟦1 • t⟧ :: (1 : ctx γ)) := rfl
@[simp] lemma ctx.add_nil {γ : ctype} : nil + nil = nil := rfl
@[simp] lemma ctx.add_cons {γ : ctype} {t : expr} {π₁ π₂ : mult} {Γ₁ Γ₂ : ctx γ} :
  ⟦π₁ • t⟧ :: Γ₁ + ⟦π₂ • t⟧ :: Γ₂ = ⟦(π₁ + π₂) • t⟧ :: (Γ₁ + Γ₂) := rfl
-- @[simp] lemma ctx.smul_nil {γ : ctype} {π : mult} : π • nil = nil := rfl
-- @[simp] lemma ctx.smul_cons {γ : ctype} {t : expr} {Γ : ctx γ} {π' π : mult} :
--   π' • ⟦π • t⟧ :: Γ = ⟦(π' * π) • t⟧ :: (π' • Γ) := rfl

@[simp]
lemma ctx.zero_add {γ : ctype} (Γ : ctx γ) : 0 + Γ = Γ := by
{ induction γ,
  case list.nil : { cases Γ, refl },
  case list.cons : t γ ih { cases Γ with _ _ π Γ', simp [ih] at ⊢ } }

@[simp]
lemma ctx.add_zero {γ : ctype} (Γ : ctx γ) : Γ + 0 = Γ := by
{ induction γ,
  case list.nil : { cases Γ, refl },
  case list.cons : t γ ih { cases Γ with _ _ π Γ', simp [ih] at ⊢ } }

lemma ctx.add_assoc {γ : ctype} (Γ₁ Γ₂ Γ₃ : ctx γ) : (Γ₁ + Γ₂) + Γ₃ = Γ₁ + (Γ₂ + Γ₃) := by
{ induction γ,
  case list.nil : { cases Γ₁, cases Γ₂, cases Γ₃, refl },
  case list.cons : t γ ih
  { cases Γ₁ with _ _ π₁ Γ₁',
    cases Γ₂ with _ _ π₂ Γ₂',
    cases Γ₃ with _ _ π₃ Γ₃',
    simp [ih] at ⊢,
    rw mult.add_assoc } }

/-
lemma ctx.add_comm {γ : ctype} (Γ₁ Γ₂ : ctx γ) : Γ₁ + Γ₂ = Γ₂ + Γ₁ := by
{ induction γ,
  case list.nil : { cases Γ₁, cases Γ₂, refl },
  case list.cons : t γ ih
  { cases Γ₁ with _ _ π₁ Γ₁',
    cases Γ₂ with _ _ π₂ Γ₂',
    simp [ih] at ⊢,
    rw mult.add_comm } }
-/

instance {γ : ctype} : add_monoid (ctx γ) :=
{ zero := ctx.zero,
  add := ctx.add,
  zero_add := ctx.zero_add,
  add_zero := ctx.add_zero,
  add_assoc := ctx.add_assoc }

/-
@[simp]
lemma ctx.one_smul {γ : ctype} (Γ : ctx γ) : (1 : mult) • Γ = Γ := by
{ induction γ,
  case list.nil : { cases Γ, refl },
  case list.cons : t γ ih { cases Γ, simp [ih] at ⊢ } }

lemma ctx.mul_smul {γ : ctype} (π₁ π₂ : mult) (Γ : ctx γ) : (π₁ * π₂) • Γ = π₁ • π₂ • Γ := by
{ induction γ,
  case list.nil : { cases Γ, refl },
  case list.cons : t γ ih { cases Γ, simp [ih] at ⊢, rw mult.mul_assoc } }

@[simp]
lemma ctx.smul_zero {γ : ctype} (π : mult) : π • (0 : ctx γ) = 0 := by
{ induction γ,
  case list.nil : { refl },
  case list.cons : t γ ih { simp at ⊢, exact ih } }

lemma ctx.smul_add {γ : ctype} (π : mult) (Γ₁ Γ₂ : ctx γ) : π • (Γ₁ + Γ₂) = π • Γ₁ + π • Γ₂ := by
{ induction γ,
  case list.nil : { cases Γ₁, cases Γ₂, refl },
  case list.cons : t γ ih { cases Γ₁, cases Γ₂, simp [ih] at ⊢, rw mult.left_distrib } }

@[simp]
lemma ctx.zero_smul {γ : ctype} (Γ : ctx γ) : (0 : mult) • Γ = 0 := by
{ induction γ,
  case list.nil : { cases Γ, refl },
  case list.cons : t γ ih { cases Γ, simp [ih] at ⊢ } }

lemma ctx.add_smul {γ : ctype} (π₁ π₂ : mult) (Γ : ctx γ) : (π₁ + π₂) • Γ = π₁ • Γ + π₂ • Γ := by
{ induction γ,
  case list.nil : { cases Γ, refl },
  case list.cons : t γ ih { cases Γ, simp [ih] at ⊢, rw mult.right_distrib } }
-/

/-
instance {γ : ctype} : module mult (ctx γ) :=
{ one_smul := ctx.one_smul,
  mul_smul := ctx.mul_smul,
  smul_zero := ctx.smul_zero,
  smul_add := ctx.smul_add,
  zero_smul := ctx.zero_smul,
  add_smul := ctx.add_smul }
-/

end
end quantitative_types


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.list.lex
import data.char

/-!
# Strings

Supplementary theorems about the `string` type.
-/

namespace string

/-- `<` on string iterators. This coincides with `<` on strings as lists. -/
def ltb : iterator → iterator → bool
| s₁ s₂ := begin
  cases s₂.has_next, {exact ff},
  cases h₁ : s₁.has_next, {exact tt},
  exact if s₁.curr = s₂.curr then
    have s₁.next.2.length < s₁.2.length, from
    match s₁, h₁ with ⟨_, a::l⟩, h := nat.lt_succ_self _ end,
    ltb s₁.next s₂.next
  else s₁.curr < s₂.curr,
end
using_well_founded {rel_tac :=
  λ _ _, `[exact ⟨_, measure_wf (λ s, s.1.2.length)⟩]}

instance has_lt' : has_lt string :=
⟨λ s₁ s₂, ltb s₁.mk_iterator s₂.mk_iterator⟩

instance decidable_lt : @decidable_rel string (<) :=
by apply_instance -- short-circuit type class inference

@[simp] theorem lt_iff_to_list_lt :
  ∀ {s₁ s₂ : string}, s₁ < s₂ ↔ s₁.to_list < s₂.to_list
| ⟨i₁⟩ ⟨i₂⟩ :=
  suffices ∀ {p₁ p₂ s₁ s₂}, ltb ⟨p₁, s₁⟩ ⟨p₂, s₂⟩ ↔ s₁ < s₂, from this,
  begin
    intros,
    induction s₁ with a s₁ IH generalizing p₁ p₂ s₂;
      cases s₂ with b s₂; rw ltb; simp [iterator.has_next],
    { refl, },
    { exact iff_of_true rfl list.lex.nil },
    { exact iff_of_false bool.ff_ne_tt (not_lt_of_lt list.lex.nil) },
    { dsimp [iterator.has_next,
        iterator.curr, iterator.next],
      split_ifs,
      { subst b, exact IH.trans list.lex.cons_iff.symm },
      { simp, refine ⟨list.lex.rel, λ e, _⟩,
        cases e, {cases h rfl}, assumption } }
  end

instance has_le : has_le string := ⟨λ s₁ s₂, ¬ s₂ < s₁⟩

instance decidable_le : @decidable_rel string (≤) :=
by apply_instance -- short-circuit type class inference

@[simp] theorem le_iff_to_list_le
  {s₁ s₂ : string} : s₁ ≤ s₂ ↔ s₁.to_list ≤ s₂.to_list :=
(not_congr lt_iff_to_list_lt).trans not_lt

theorem to_list_inj : ∀ {s₁ s₂}, to_list s₁ = to_list s₂ ↔ s₁ = s₂
| ⟨s₁⟩ ⟨s₂⟩ := ⟨congr_arg _, congr_arg _⟩

lemma nil_as_string_eq_empty : [].as_string = "" := rfl

@[simp] lemma to_list_empty : "".to_list = [] := rfl

lemma as_string_inv_to_list (s : string) : s.to_list.as_string = s :=
by { cases s, refl }

@[simp] lemma to_list_singleton (c : char) : (string.singleton c).to_list = [c] := rfl

lemma to_list_nonempty : ∀ {s : string}, s ≠ string.empty →
  s.to_list = s.head :: (s.popn 1).to_list
| ⟨s⟩ h := by cases s; [cases h rfl, refl]

@[simp] lemma head_empty : "".head = default := rfl

@[simp] lemma popn_empty {n : ℕ} : "".popn n = "" :=
begin
  induction n with n hn,
  { refl },
  { rcases hs : "" with ⟨_ | ⟨hd, tl⟩⟩,
    { rw hs at hn,
      conv_rhs { rw ←hn },
      simp only [popn, mk_iterator, iterator.nextn, iterator.next] },
    { simpa only [←to_list_inj] using hs } }
end

instance : linear_order string :=
{ lt := (<), le := (≤),
  decidable_lt := by apply_instance,
  decidable_le := string.decidable_le,
  decidable_eq := by apply_instance,
  le_refl := λ a, le_iff_to_list_le.2 le_rfl,
  le_trans := λ a b c, by { simp only [le_iff_to_list_le], exact λ h₁ h₂, h₁.trans h₂ },
  le_total := λ a b, by { simp only [le_iff_to_list_le], exact le_total _ _ },
  le_antisymm := λ a b, by { simp only [le_iff_to_list_le, ← to_list_inj], apply le_antisymm },
  lt_iff_le_not_le := λ a b, by simp only [le_iff_to_list_le, lt_iff_to_list_lt, lt_iff_le_not_le] }

end string

open string

lemma list.to_list_inv_as_string (l : list char) : l.as_string.to_list = l :=
by { cases hl : l.as_string, exact string_imp.mk.inj hl.symm }

@[simp] lemma list.length_as_string (l : list char) : l.as_string.length = l.length := rfl

@[simp] lemma list.as_string_inj {l l' : list char} : l.as_string = l'.as_string ↔ l = l' :=
⟨λ h, by rw [←list.to_list_inv_as_string l, ←list.to_list_inv_as_string l', to_list_inj, h],
 λ h, h ▸ rfl⟩

@[simp] lemma string.length_to_list (s : string) : s.to_list.length = s.length :=
by rw [←string.as_string_inv_to_list s, list.to_list_inv_as_string, list.length_as_string]

lemma list.as_string_eq {l : list char} {s : string} :
  l.as_string = s ↔ l = s.to_list :=
by rw [←as_string_inv_to_list s, list.as_string_inj, as_string_inv_to_list s]