(*  Title:      HOL/Library/Pattern_Aliases.thy
    Author:     Lars Hupel, Ondrej Kuncar, Tobias Nipkow
*)

section \<open>Input syntax for pattern aliases (or ``as-patterns'' in Haskell)\<close>

theory Pattern_Aliases
imports MainRLT
begin

text \<open>
  Most functional languages (Haskell, ML, Scala) support aliases in patterns. This allows to refer
  to a subpattern with a variable name. This theory implements this using a check phase. It works
  well for function definitions (see usage below). All features are packed into a @{command bundle}.

  The following caveats should be kept in mind:
  \<^item> The translation expects a term of the form \<^prop>\<open>f x y = rhs\<close>, where \<open>x\<close> and \<open>y\<close> are patterns
    that may contain aliases. The result of the translation is a nested \<^const>\<open>Let\<close>-expression on
    the right hand side. The code generator \<^emph>\<open>does not\<close> print Isabelle pattern aliases to target
    language pattern aliases.
  \<^item> The translation does not process nested equalities; only the top-level equality is translated.
  \<^item> Terms that do not adhere to the above shape may either stay untranslated or produce an error
    message. The @{command fun} command will complain if pattern aliases are left untranslated.
    In particular, there are no checks whether the patterns are wellformed or linear.
  \<^item> The corresponding uncheck phase attempts to reverse the translation (no guarantee). The
    additionally introduced variables are bound using a ``fake quantifier'' that does not
    appear in the output.
  \<^item> To obtain reasonable induction principles in function definitions, the bundle also declares
    a custom congruence rule for \<^const>\<open>Let\<close> that only affects @{command fun}. This congruence
    rule might lead to an explosion in term size (although that is rare)! In some circumstances
    (using \<open>let\<close> to destructure tuples), the internal construction of functions stumbles over this
    rule and prints an error. To mitigate this, either
    \<^item> activate the bundle locally (\<^theory_text>\<open>context includes ... begin\<close>) or
    \<^item> rewrite the \<open>let\<close>-expression to use \<open>case\<close>: \<^term>\<open>let (a, b) = x in (b, a)\<close> becomes
      \<^term>\<open>case x of (a, b) \<Rightarrow> (b, a)\<close>.
  \<^item> The bundle also adds the @{thm Let_def} rule to the simpset.
\<close>

subsection \<open>Definition\<close>

consts
  as :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
  fake_quant :: "('a \<Rightarrow> prop) \<Rightarrow> prop"

lemma let_cong_unfolding: "M = N \<Longrightarrow> f N = g N \<Longrightarrow> Let M f = Let N g"
by simp

translations "P" <= "CONST fake_quant (\<lambda>x. P)"

ML\<open>
local

fun let_typ a b = a --> (a --> b) --> b
fun as_typ a = a --> a --> a

fun strip_all t =
  case try Logic.dest_all_global t of
    NONE => ([], t)
  | SOME (var, t) => apfst (cons var) (strip_all t)

fun all_Frees t =
  fold_aterms (fn Free (x, t) => insert (op =) (x, t) | _ => I) t []

fun subst_once (old, new) t =
  let
    fun go t =
      if t = old then
        (new, true)
      else
        case t of
          u $ v =>
            let
              val (u', substituted) = go u
            in
              if substituted then
                (u' $ v, true)
              else
                case go v of (v', substituted) => (u $ v', substituted)
            end
        | Abs (name, typ, t) =>
            (case go t of (t', substituted) => (Abs (name, typ, t'), substituted))
        | _ => (t, false)
  in fst (go t) end

(* adapted from logic.ML *)
fun fake_const T = Const (\<^const_name>\<open>fake_quant\<close>, (T --> propT) --> propT);

fun dependent_fake_name v t =
  let
    val x = Term.term_name v
    val T = Term.fastype_of v
    val t' = Term.abstract_over (v, t)
  in if Term.is_dependent t' then fake_const T $ Abs (x, T, t') else t end

in

fun check_pattern_syntax t =
  case strip_all t of
    (vars, \<^Const>\<open>Trueprop\<close> $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ lhs $ rhs)) =>
      let
        fun go (Const (\<^const_name>\<open>as\<close>, _) $ pat $ var, rhs) =
              let
                val (pat', rhs') = go (pat, rhs)
                val _ = if is_Free var then () else error "Right-hand side of =: must be a free variable"
                val rhs'' =
                  Const (\<^const_name>\<open>Let\<close>, let_typ (fastype_of var) (fastype_of rhs)) $
                    pat' $ lambda var rhs'
              in
                (pat', rhs'')
              end
          | go (t $ u, rhs) =
              let
                val (t', rhs') = go (t, rhs)
                val (u', rhs'') = go (u, rhs')
              in (t' $ u', rhs'') end
          | go (t, rhs) = (t, rhs)

        val (lhs', rhs') = go (lhs, rhs)

        val res = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs', rhs'))

        val frees = filter (member (op =) vars) (all_Frees res)
      in fold (fn v => Logic.dependent_all_name ("", v)) (map Free frees) res end
  | _ => t

fun uncheck_pattern_syntax ctxt t =
  case strip_all t of
    (vars, \<^Const>\<open>Trueprop\<close> $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ lhs $ rhs)) =>
      let
        (* restricted to going down abstractions; ignores eta-contracted rhs *)
        fun go lhs (rhs as Const (\<^const_name>\<open>Let\<close>, _) $ pat $ Abs (name, typ, t)) ctxt frees =
              if exists_subterm (fn t' => t' = pat) lhs then
                let
                  val ([name'], ctxt') = Variable.variant_fixes [name] ctxt
                  val free = Free (name', typ)
                  val subst = (pat, Const (\<^const_name>\<open>as\<close>, as_typ typ) $ pat $ free)
                  val lhs' = subst_once subst lhs
                  val rhs' = subst_bound (free, t)
                in
                  go lhs' rhs' ctxt' (Free (name', typ) :: frees)
                end
              else
                (lhs, rhs, ctxt, frees)
          | go lhs rhs ctxt frees = (lhs, rhs, ctxt, frees)

        val (lhs', rhs', _, frees) = go lhs rhs ctxt []

        val res =
          HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs', rhs'))
          |> fold (fn v => Logic.dependent_all_name ("", v)) (map Free vars)
          |> fold dependent_fake_name frees
      in
        if null frees then t else res
      end
  | _ => t

end
\<close>

bundle pattern_aliases begin

  notation as (infixr "=:" 1)

  declaration \<open>K (Syntax_Phases.term_check 98 "pattern_syntax" (K (map check_pattern_syntax)))\<close>
  declaration \<open>K (Syntax_Phases.term_uncheck 98 "pattern_syntax" (map o uncheck_pattern_syntax))\<close>

  declare let_cong_unfolding [fundef_cong]
  declare Let_def [simp]

end

hide_const as
hide_const fake_quant

subsection \<open>Usage\<close>

context includes pattern_aliases begin

text \<open>Not very useful for plain definitions, but works anyway.\<close>

private definition "test_1 x (y =: z) = y + z"

lemma "test_1 x y = y + y"
by (rule test_1_def[unfolded Let_def])

text \<open>Very useful for function definitions.\<close>

private fun test_2 where
"test_2 (y # (y' # ys =: x') =: x) = x @ x' @ x'" |
"test_2 _ = []"

lemma "test_2 (y # y' # ys) = (y # y' # ys) @ (y' # ys) @ (y' # ys)"
by (rule test_2.simps[unfolded Let_def])

ML\<open>
let
  val actual =
    @{thm test_2.simps(1)}
    |> Thm.prop_of
    |> Syntax.string_of_term \<^context>
    |> YXML.content_of
  val expected = "test_2 (?y # (?y' # ?ys =: x') =: x) = x @ x' @ x'"
in \<^assert> (actual = expected) end
\<close>

end

end


(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics written for Isabelle/Isar.

    Copyright (C) 2023  Daniel de la Concepcion

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,
INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES LOSS OF USE, DATA, OR PROFITS OR
BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>Rings - Zariski Topology - maps\<close>

theory Ring_Zariski_ZF_3 imports Ring_Zariski_ZF Ring_ZF_3 Topology_ZF_2

begin

lemma (in ring_homo) spectrum_surj:
  defines "g \<equiv> \<lambda>u\<in>target_ring.Spec. f-``u"
  assumes "f\<in>surj(R,S)"
  shows "g: target_ring.Spec \<rightarrow> V(ker)"
proof-
  have "g: target_ring.Spec \<rightarrow> {f-``u. u\<in>target_ring.Spec}" using lam_funtype
    unfolding g_def by auto moreover
  {
    fix t assume "t\<in>{f-``u. u\<in>target_ring.Spec}"
    then obtain u where u:"u:target_ring.Spec" "t=f-``u" by auto
    from u(1) have u2:"u\<triangleleft>\<^sub>pR\<^sub>t" unfolding target_ring.Spec_def by auto
    then have "(f-``u)\<triangleleft>\<^sub>pR\<^sub>o" using preimage_prime_ideal_surj
      assms(2) by auto moreover
    then have "f-``u \<in> origin_ring.ideals"
      unfolding origin_ring.primeIdeal_def
      using origin_ring.ideal_dest_subset by auto
    ultimately have "f-``u \<in> origin_ring.Spec" unfolding origin_ring.Spec_def
      by auto
    moreover from u2 have "\<zero>\<^sub>S \<in> u" unfolding
      target_ring.primeIdeal_def using target_ring.ideal_dest_zero
      by auto
    then have "{\<zero>\<^sub>S} \<subseteq> u" by auto
    then have "f-``{\<zero>\<^sub>S} \<subseteq> f-``u" by auto
    moreover have "f-``u \<subseteq> R" using func1_1_L15[OF
      surj_is_fun[OF assms(2)]] by auto
    ultimately have "f-``u \<in> origin_ring.closeBasic(f-``{\<zero>\<^sub>S})"
      using origin_ring.closeBasic_def[of "f-``{\<zero>\<^sub>S}"]
      by force
    with u(2) have "t\<in>origin_ring.closeBasic(f-``{\<zero>\<^sub>S})" by auto
  }
  then have "{f-``u. u\<in>target_ring.Spec} \<subseteq> origin_ring.closeBasic(f-``{\<zero>\<^sub>S})" by auto
  ultimately show ?thesis using func1_1_L1B by auto
qed

lemma (in ring_homo) spectrum_surj_bij:
  defines "g \<equiv> \<lambda>u\<in>target_ring.Spec. f-``u"
  assumes "f\<in>surj(R,S)"
  shows "g\<in>bij(target_ring.Spec, V(ker))"
proof-
  {
    fix s t assume st:"s\<in>target_ring.Spec" "t\<in>target_ring.Spec"
      "g`s = g`t"
    then have "f-``s = f-``t" using beta unfolding g_def by auto
    then have "f``(f-``s) = f``(f-``t)" by auto
    moreover from st(1,2) have "s \<subseteq> S" "t \<subseteq>S"
      unfolding target_ring.Spec_def origin_ring.Spec_def
      by auto
    moreover note assms(2) st(1,2)
    ultimately have "s=t" using surj_image_vimage
      unfolding target_ring.Spec_def origin_ring.Spec_def
      by auto
  }
  then have "g\<in>inj(target_ring.Spec, origin_ring.closeBasic(f-``{\<zero>\<^sub>S}))"
    unfolding inj_def using spectrum_surj assms(2) unfolding g_def by auto
  moreover
  {
    fix t assume t:"t\<in>origin_ring.closeBasic(f-``{\<zero>\<^sub>S})"
    then have tt:"t\<in>origin_ring.Spec" "f-``{\<zero>\<^sub>S} \<subseteq> t"
      using origin_ring.closeBasic_def func1_1_L6A[OF surj_is_fun]
      assms(2) by auto
    {
      fix y assume y:"y\<in>f-``(f``t)"
      then have y:"y\<in>R" "f`y\<in>f``t" using func1_1_L15
        surj_is_fun[OF assms(2)] by auto
      from y(2) obtain x where x:"x\<in>t" "f`y = f`x"
        using func_imagedef[OF surj_is_fun]
        assms(2) tt(1) unfolding origin_ring.Spec_def by auto
      from x(2) have "(f`y)\<rs>\<^sub>S(f`x) = (f`x)\<rs>\<^sub>S(f`x)" by auto
      then have "(f`y)\<rs>\<^sub>S(f`x) = \<zero>\<^sub>S" using target_ring.Ring_ZF_1_L3(7)
        apply_type[OF surj_is_fun] assms(2) x(1) tt(1)
        unfolding origin_ring.Spec_def by auto
      then have "f`(y\<rs>\<^sub>Rx) = \<zero>\<^sub>S" using homomor_dest_subs
        x(1) tt(1) y(1) unfolding origin_ring.Spec_def by auto moreover
      from x(1) tt(1) have "x\<in>R" unfolding origin_ring.Spec_def by auto
      with y(1) have "y\<rs>\<^sub>Rx \<in>R" using origin_ring.Ring_ZF_1_L4(2) by auto
      ultimately have "y\<rs>\<^sub>Rx \<in> f-``{\<zero>\<^sub>S}" using func1_1_L15
        surj_is_fun[OF assms(2)] by auto
      then have "y\<rs>\<^sub>Rx \<in>t" using tt(2) by auto moreover
      have "t\<triangleleft>R\<^sub>o" using tt(1) unfolding origin_ring.Spec_def by auto
      ultimately have "x\<ra>\<^sub>R(y\<rs>\<^sub>Rx) \<in>t" using x(1)
        origin_ring.ideal_dest_sum by auto
      then have "y\<in>t" using origin_ring.Ring_ZF_2_L1A(5)
        y(1) \<open>x\<in>R\<close> by auto
    }
    then have "f-``(f``t) = t" using func1_1_L9[of f R S t]
      surj_is_fun[OF assms(2)] tt(1) unfolding origin_ring.Spec_def
      by auto moreover
    then have "(f``t)\<triangleleft>\<^sub>pR\<^sub>t" using prime_ideal_quot_3[of "f``t"]
      assms(2) tt(1) unfolding origin_ring.Spec_def
      using image_ideal_surj[of t] origin_ring.primeIdeal_def[of t]
      by auto
    then have "(f``t)\<triangleleft>\<^sub>pR\<^sub>t" "(f``t)\<triangleleft>R\<^sub>t"
      using target_ring.primeIdeal_def[of "f``t"]
      by auto
    then have "(f``t):target_ring.Spec"
      unfolding target_ring.Spec_def using target_ring.ideal_dest_subset
      by auto moreover
    then have "f-``(f``t) = g`(f``t)" unfolding g_def
      using beta by auto
    ultimately have "g`(f``t) = t" "(f``t):target_ring.Spec" by auto
    then have "\<exists>p\<in>target_ring.Spec. g`p = t" by auto
  }
  ultimately show "g:bij(target_ring.Spec, V(ker))"
    unfolding bij_def surj_def inj_def by auto
qed

definition (in ring_homo) top_origin ("\<tau>\<^sub>o") where
  "top_origin \<equiv> {origin_ring.openBasic(J) . J \<in> origin_ring.ideals}"

definition (in ring_homo) top_target ("\<tau>\<^sub>t") where
  "top_target \<equiv> {target_ring.openBasic(J) . J \<in> target_ring.ideals}"

definition (in ring_homo) spec_cont where
 "spec_cont(h) \<equiv> IsContinuous(\<tau>\<^sub>t, \<tau>\<^sub>o, h)"

lemma (in ring_homo) spectrum_surj_cont:
  defines "g \<equiv> \<lambda>u\<in>target_ring.Spec. f-``u"
  assumes "f\<in>surj(R,S)"
  shows "IsContinuous(\<tau>\<^sub>t, \<tau>\<^sub>o {restricted to}(V(ker)), g)"
  unfolding IsContinuous_def top_target_def RestrictedTo_def top_origin_def
proof(safe)
  fix x assume ass:"x\<triangleleft>R\<^sub>o" "x \<subseteq> R"
  have "origin_ring.openBasic(x) = {u\<in>origin_ring.Spec. \<not>(x \<subseteq> u)}"
    unfolding origin_ring.openBasic_def[OF ass(2)] by auto
  have "g-``(origin_ring.openBasic(x)) = {t\<in>target_ring.Spec. g`t \<in> origin_ring.openBasic(x)}"
    using spectrum_surj assms(2) unfolding g_def
    using func1_1_L15 by auto
  then have G:"g-``(origin_ring.openBasic(x)) = {t\<in>target_ring.Spec. f-``t \<in> origin_ring.openBasic(x)}"
    using beta unfolding g_def by auto
  have "(f``x)\<triangleleft>R\<^sub>t" using image_ideal_surj assms(2) ass(1) by auto
  then have H:"f``x\<in>target_ring.ideals" using
    target_ring.ideal_dest_subset by auto
  then have F:"target_ring.openBasic(f``x) = {t\<in>target_ring.Spec. \<not>(f``x \<subseteq> t)}"
    using target_ring.openBasic_def by auto
  {
    fix s assume "s\<in>{t\<in>target_ring.Spec. f-``t \<in> origin_ring.openBasic(x)}"
    then have s:"s\<in>target_ring.Spec" "f-``s \<in> origin_ring.openBasic(x)"
      by auto
    from this(2) have E:"f-``s \<in>origin_ring.Spec" "\<not>(x \<subseteq> f-``s)"
      using origin_ring.openBasic_def ass(1) origin_ring.ideal_dest_subset
      by auto
    {
      assume "f``x \<subseteq> s"
      then have "f-``(f``x) \<subseteq> f-``s" by auto
      then have "x \<subseteq> f-``s" using func1_1_L9[OF surj_is_fun]
        assms(2) ass(1) origin_ring.ideal_dest_subset by force
      with E(2) have False by auto
    }
    then have "\<not>(f``x \<subseteq> s)" by auto
    with s(1) have "s\<in>{t\<in>target_ring.Spec. \<not>(f``x \<subseteq> t)}"
      by auto
  }
  then have "{t \<in> target_ring.Spec . f -`` t \<in> origin_ring.openBasic(x)} \<subseteq> {t\<in>target_ring.Spec. \<not>(f``x \<subseteq> t)}"
    by auto moreover
  {
    fix s assume "s\<in>{t\<in>target_ring.Spec. \<not>(f``x \<subseteq> t)}"
    then have s:"s\<in>target_ring.Spec" "\<not>(f``x \<subseteq> s)" by auto
    have "origin_ring.openBasic(x) = {t\<in>origin_ring.Spec. \<not>(x \<subseteq> t)}"
      using origin_ring.openBasic_def ass(1) origin_ring.ideal_dest_subset
      by auto
    {
      assume "x \<subseteq> f-``s"
      then have "f``x \<subseteq> f``(f-``s)" by auto
      then have "f``x \<subseteq> s" using surj_image_vimage
        assms(2) s(1) unfolding target_ring.Spec_def
          target_ring.primeIdeal_def target_ring.ideal_dest_subset
        by auto
      with s(2) have False by auto
    }
    then have "\<not>(x \<subseteq> f-``s)" by auto
    moreover
    from s(1) have "(f-``s) \<triangleleft>\<^sub>pR\<^sub>o" unfolding target_ring.Spec_def
      using preimage_prime_ideal_surj assms(2) by auto
    then have "(f-``s)\<in>origin_ring.Spec" unfolding origin_ring.Spec_def
      origin_ring.primeIdeal_def using origin_ring.ideal_dest_subset
      by auto
    ultimately have "f-``s\<in>origin_ring.openBasic(x)"
      using origin_ring.openBasic_def ass(1)
      origin_ring.ideal_dest_subset by auto
    then have "s\<in>{t \<in> target_ring.Spec . f -`` t \<in> origin_ring.openBasic(x)}"
      using s(1) by auto
  }
  then have "{t \<in> target_ring.Spec . \<not> f `` x \<subseteq> t} \<subseteq> {t \<in> target_ring.Spec . f -`` t \<in> origin_ring.openBasic(x)}"
    by auto
  ultimately have "{t \<in> target_ring.Spec . \<not> f `` x \<subseteq> t} = {t \<in> target_ring.Spec . f -`` t \<in> origin_ring.openBasic(x)}"
    by auto
  with F have "target_ring.openBasic(f``x) = {t \<in> target_ring.Spec . f -`` t \<in> origin_ring.openBasic(x)}"
    by auto
  with G have T:"target_ring.openBasic(f``x) = g-`` origin_ring.openBasic(x)" by auto
  have "g-``(origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})) = {t\<in>target_ring.Spec. g`t \<in> origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})}"
    using spectrum_surj assms(2) unfolding g_def
    using func1_1_L15 by auto
  then have "g-``(origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})) = {t\<in>target_ring.Spec. f-``t \<in> origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})}"
    using beta unfolding g_def by auto
  then have E:"g-``(origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})) = {t\<in>target_ring.Spec. f-``t \<in> {q\<in>origin_ring.Spec. (f -`` {\<zero>\<^sub>S}) \<subseteq> q}}"
    unfolding origin_ring.closeBasic_def[OF func1_1_L3[OF surj_is_fun[OF assms(2)]]] by auto
  {
    fix s assume s:"s\<in>target_ring.openBasic(f``x)"
    with E have ss:"s\<in>target_ring.Spec" "\<not>(f``x \<subseteq> s)"
      using target_ring.openBasic_def func1_1_L6(2) surj_is_fun[OF assms(2)] by auto
    from this(1) have "g`s \<in> origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})" using spectrum_surj[OF assms(2)]
      apply_type[of g target_ring.Spec "\<lambda>u. origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})"] unfolding g_def
      by auto
    with ss(1) have "f-``s \<in> origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})" using beta
      unfolding g_def by auto
    moreover
    from ss(1) have "s\<triangleleft>R\<^sub>t" unfolding target_ring.Spec_def
      target_ring.primeIdeal_def by auto
    then have "\<zero>\<^sub>S \<in>s" using target_ring.ideal_dest_zero by auto
    then have "{\<zero>\<^sub>S} \<subseteq> s" by auto
    then have "f-``{\<zero>\<^sub>S} \<subseteq> f-``s" by auto
    moreover
    have "f-``{\<zero>\<^sub>S} \<subseteq> R" using func1_1_L15[OF
      surj_is_fun[OF assms(2)], of "{\<zero>\<^sub>S}"] by auto
    ultimately have "f-``s \<in> {q\<in>origin_ring.Spec. (f -`` {\<zero>\<^sub>S}) \<subseteq> q}"
      using origin_ring.closeBasic_def by auto
    then have "s\<in>{t\<in>target_ring.Spec. f-``t \<in> {q\<in>origin_ring.Spec. (f -`` {\<zero>\<^sub>S}) \<subseteq> q}}"
      using ss(1) by auto
    then have "s\<in>g-``(origin_ring.closeBasic(f -`` {\<zero>\<^sub>S}))" using E by auto
  }
  then have "target_ring.openBasic(f``x) \<subseteq> g-``(origin_ring.closeBasic(f -`` {\<zero>\<^sub>S}))" by auto
  then have "g-``(origin_ring.closeBasic(f -`` {\<zero>\<^sub>S}))\<inter>target_ring.openBasic(f``x) = target_ring.openBasic(f``x)"
    by auto
  with T have "g-``(origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})) \<inter> g -`` origin_ring.openBasic(x) = target_ring.openBasic(f``x)"
    by auto moreover
  have "g-``(origin_ring.closeBasic(f -`` {\<zero>\<^sub>S})) \<inter> g -`` origin_ring.openBasic(x) =
    g-``(origin_ring.closeBasic(f -`` {\<zero>\<^sub>S}) \<inter> origin_ring.openBasic(x))"
    using invim_inter_inter_invim[OF spectrum_surj[OF assms(2)]]
    unfolding g_def by auto
  ultimately have "g -``
       (origin_ring.closeBasic(f -`` {\<zero>\<^sub>S}) \<inter>
        origin_ring.openBasic(x)) = target_ring.openBasic(f``x)"
    by auto
  with H show "g -``
       (origin_ring.closeBasic(f -`` {\<zero>\<^sub>S}) \<inter>
        origin_ring.openBasic(x)) \<in>
           RepFun(target_ring.ideals, target_ring.openBasic)"
    by auto
qed

lemma (in ring_homo) spectrum_surj_open:
  defines "g \<equiv> \<lambda>u\<in>target_ring.Spec. f-``u"
  assumes "f\<in>surj(R,S)"
  shows "\<forall>U\<in>\<tau>\<^sub>t. g``U \<in> \<tau>\<^sub>o {restricted to} V(ker)"
proof
  fix U assume U:"U\<in>\<tau>\<^sub>t"
  then obtain I where I:"I\<triangleleft>R\<^sub>t" "I\<subseteq>S"
    "U=target_ring.openBasic(I)" unfolding top_target_def
    by auto
  from I(3) have sub:"U \<subseteq> target_ring.Spec"
    using target_ring.openBasic_def[OF I(2)] by auto
  {
    fix t assume t:"t\<in>g``U"
    then obtain u where u:"u\<in>U" "t=g`u"
      using func_imagedef spectrum_surj[OF assms(2)] sub
      unfolding g_def by auto
    then have t:"t=f-``u" using beta sub unfolding g_def by auto
    with sub u(1) have "t\<triangleleft>\<^sub>pR\<^sub>o" unfolding target_ring.Spec_def
      using preimage_prime_ideal_surj[OF _ assms(2), of u]
      by auto
    then have p:"t\<in>origin_ring.Spec" unfolding origin_ring.Spec_def
      unfolding origin_ring.primeIdeal_def
      using origin_ring.ideal_dest_subset by auto
    from u(1) I(2,3) have Iu:"\<not> (I \<subseteq> u)" using target_ring.openBasic_def
      by auto
    {
      assume "f-``I \<subseteq> t"
      then have "f``(f-``I) \<subseteq> f``t" by auto
      then have "I \<subseteq> f``t" using surj_image_vimage[OF assms(2)] I(2) by auto
      with t have "I \<subseteq> f``(f-``u)" by auto
      moreover from u(1) sub have "u \<subseteq> S"
        unfolding target_ring.Spec_def by auto
      ultimately have "I \<subseteq> u" using surj_image_vimage[OF assms(2)]
        by auto
      with Iu have False by auto
    }
    then have "\<not>(f-``I \<subseteq> t)" by auto
    with p have "t\<in>origin_ring.openBasic(f-``I)"
      using origin_ring.openBasic_def func1_1_L6A[OF surj_is_fun]
      assms(2) by auto
  }
  then have "g``U \<subseteq> origin_ring.openBasic(f-``I)" by auto moreover
  {
    fix t assume t:"t\<in>origin_ring.openBasic(f-``I)" "t\<in>V(ker)"
    have "f-``I \<subseteq> R" using func1_1_L6A[OF surj_is_fun]
      assms(2) by auto
    with t have p:"t\<in>origin_ring.Spec" "\<not>(f-``I \<subseteq> t)"
      using origin_ring.openBasic_def by auto
    from t(2) have kt:"ker \<subseteq> t" using origin_ring.closeBasic_def[OF
      func1_1_L3[OF fun]] by auto
    {
      fix x assume "x\<in>f-``(f``t)"
      then have t:"f`x\<in>f``t" "x\<in>R" using func1_1_L15
        surj_is_fun[OF assms(2)] by auto
      then obtain s where s:"f`x = f`s" "s\<in>t" using
        func_imagedef[OF surj_is_fun[OF assms(2)]]
        p(1) unfolding origin_ring.Spec_def by auto
      from s(2) have ss:"s\<in>R" using p(1)
        unfolding origin_ring.Spec_def by auto
      from s(1) have "(f`x) \<rs>\<^sub>S (f`s) = \<zero>\<^sub>S" using
        target_ring.Ring_ZF_1_L3(7)[OF apply_type[OF
            surj_is_fun[OF assms(2)]
        t(2)]] by auto
      then have "f`(x\<rs>\<^sub>Rs) = \<zero>\<^sub>S" using homomor_dest_subs
        t(2) ss by auto moreover
      from t(2) ss have "x\<rs>\<^sub>Rs \<in>R" using origin_ring.Ring_ZF_1_L4(2) by auto
      ultimately have "x\<rs>\<^sub>Rs \<in> f-``{\<zero>\<^sub>S}" using func1_1_L15
        surj_is_fun[OF assms(2)] by auto
      then have "x\<rs>\<^sub>Rs \<in> t" using kt by auto
      then have "s\<ra>\<^sub>R(x\<rs>\<^sub>Rs) \<in> t"
        using origin_ring.ideal_dest_sum
        s(2) p(1) unfolding origin_ring.Spec_def by auto
      then have "x\<in>t" using origin_ring.Ring_ZF_2_L1A(5)
        ss t(2) by auto
    }
    then have eq:"f-``(f``t) = t"
      using func1_1_L9[OF surj_is_fun[OF assms(2)]
      origin_ring.ideal_dest_subset[of t]] p(1) unfolding origin_ring.Spec_def
      origin_ring.primeIdeal_def by auto
    then have "(f `` t)\<triangleleft>R\<^sub>t \<Longrightarrow> (f``t)\<triangleleft>\<^sub>pR\<^sub>t"
      using prime_ideal_quot_3[of "f``t"] assms(2)
      p(1) unfolding origin_ring.Spec_def by auto
    then have id:"(f``t)\<triangleleft>\<^sub>pR\<^sub>t" "(f `` t)\<triangleleft>R\<^sub>t" using image_ideal_surj
      p(1) assms(2) unfolding origin_ring.Spec_def by auto
    {
      assume "I \<subseteq> f``t"
      then have "f-``I \<subseteq> f-``(f``t)" by auto
      with eq have "f-``I \<subseteq> t" by auto
      with p(2) have False by auto
    }
    then have "\<not>(I \<subseteq> f``t)" by auto
    then have "f``t\<in>target_ring.openBasic(I)"
      using id target_ring.ideal_dest_subset unfolding target_ring.openBasic_def[OF I(2)]
      target_ring.Spec_def by auto
    then have q:"f``t \<in>U" using I(3) by auto
    then have q2:"f``t\<in>target_ring.Spec" using sub by auto
    from q have "g`(f``t) \<in>g``U" using func1_1_L15D[OF bij_is_fun
      [OF spectrum_surj_bij[OF assms(2)]], of "f``t" U]
      unfolding g_def using sub by auto
    then have "f-``(f``t) \<in> g``U" using beta[of "f``t"
      target_ring.Spec "\<lambda>o. f-``o"] q2
      unfolding g_def by auto
    with eq have "t\<in>g``U" by auto
  }
  then have "V(ker)\<inter>D(f -`` I) \<subseteq> g``U" by auto
  ultimately
  have "V(ker)\<inter>D(f -`` I) = g``U"
    using func1_1_L6(2)[OF bij_is_fun[OF
    spectrum_surj_bij[OF assms(2)]],of U]
    unfolding g_def by blast
  moreover
  have "D(f -`` I) \<in>\<tau>\<^sub>o" unfolding top_origin_def
    using preimage_ideal(1)[OF I(1)]
      origin_ring.ideal_dest_subset by auto
  then have "V(ker)\<inter>D(f -`` I) \<in> {V(ker) \<inter> A . A \<in> \<tau>\<^sub>o}"
    by auto
  ultimately show "g``U:  \<tau>\<^sub>o{restricted to}V(ker)"
    unfolding RestrictedTo_def by auto
qed

text\<open>A quotient ring has an spectrum homeomorphic
to a closed subspace of the spectrum of the base ring.
Specifically, the close subspace associated to the
ideal by which we quotient.\<close>

corollary (in ring_homo) surj_homeomorphism:
  assumes "f\<in>surj(R,S)"
  defines "g \<equiv> \<lambda>u\<in>target_ring.Spec. f -`` u"
  shows "IsAhomeomorphism(\<tau>\<^sub>t, \<tau>\<^sub>o{restricted to}V(ker), g)"
proof-
  have "\<Union>(\<tau>\<^sub>o{restricted to}V(ker)) = origin_ring.Spec \<inter> V(ker)" unfolding
    top_origin_def RestrictedTo_def using origin_ring.total_spec
    by auto
  then have "\<Union>(\<tau>\<^sub>o{restricted to}V(ker)) = V(ker)"
    using origin_ring.closeBasic_def[OF func1_1_L3[OF fun,
    of "{\<zero>\<^sub>S}"]] by auto moreover
  have "\<Union>\<tau>\<^sub>t = target_ring.Spec" unfolding top_target_def
    using target_ring.total_spec by auto
  ultimately show ?thesis using bij_cont_open_homeo[of g \<tau>\<^sub>t "\<tau>\<^sub>o{restricted to}V(ker)"]
    spectrum_surj_bij[OF assms(1)] spectrum_surj_open[OF assms(1)]
    spectrum_surj_cont[OF assms(1)]
    unfolding g_def by auto
qed

end