lemma XYIdeal_mul_XYIdeal {x₁ x₂ y₁ y₂ : F} (h₁ : W.equation x₁ y₁) (h₂ : W.equation x₂ y₂)
    (hxy : x₁ = x₂ → y₁ ≠ W.negY x₂ y₂) :
    XIdeal W (W.addX x₁ x₂ <| W.slope x₁ x₂ y₁ y₂) * (XYIdeal W x₁ (C y₁) * XYIdeal W x₂ (C y₂)) =
      YIdeal W (linePolynomial x₁ y₁ <| W.slope x₁ x₂ y₁ y₂) *
        XYIdeal W (W.addX x₁ x₂ <| W.slope x₁ x₂ y₁ y₂)
          (C <| W.addY x₁ x₂ y₁ <| W.slope x₁ x₂ y₁ y₂) := by
  have sup_rw : ∀ a b c d : Ideal W.CoordinateRing, a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c :=
    fun _ _ c _ => by rw [← sup_assoc, @sup_comm _ _ c, sup_sup_sup_comm, ← sup_assoc]
  rw [XYIdeal_add_eq, XIdeal, mul_comm, XYIdeal_eq₁ W x₁ y₁ <| W.slope x₁ x₂ y₁ y₂, XYIdeal,
    XYIdeal_eq₂ h₁ h₂ hxy, XYIdeal, span_pair_mul_span_pair]
  simp_rw [span_insert, sup_rw, sup_mul, span_singleton_mul_span_singleton]
  rw [← neg_eq_iff_eq_neg.mpr <| C_addPolynomial_slope h₁ h₂ hxy, span_singleton_neg,
    C_addPolynomial, _root_.map_mul, YClass]
  simp_rw [mul_comm <| XClass W x₁, mul_assoc, ← span_singleton_mul_span_singleton, ← mul_sup]
  rw [span_singleton_mul_span_singleton, ← span_insert,
    ← span_pair_add_mul_right <| -(XClass W <| W.addX x₁ x₂ <| W.slope x₁ x₂ y₁ y₂), mul_neg,
    ← sub_eq_add_neg, ← sub_mul, ← map_sub <| mk W, sub_sub_sub_cancel_right,
    span_insert, ← span_singleton_mul_span_singleton, ← sup_rw, ← sup_mul, ← sup_mul]
  apply congr_arg (_ ∘ _)
  convert top_mul (_ : Ideal W.CoordinateRing)
  simp_rw [XClass, ← @Set.image_singleton _ _ <| mk W, ← map_span, ← Ideal.map_sup,
    eq_top_iff_one, mem_map_iff_of_surjective _ AdjoinRoot.mk_surjective, ← span_insert,
    mem_span_insert', mem_span_singleton']
  by_cases hx : x₁ = x₂
  · rcases hx, Yeq_of_Yne h₁ h₂ hx (hxy hx) with ⟨rfl, rfl⟩
    let y := (y₁ - W.negY x₁ y₁) ^ 2
    replace hxy := pow_ne_zero 2 (sub_ne_zero_of_ne <| hxy rfl)
    refine ⟨1 + C (C <| y⁻¹ * 4) * W.polynomial,
      ⟨C <| C y⁻¹ * (C 4 * X ^ 2 + C (4 * x₁ + W.b₂) * X + C (4 * x₁ ^ 2 + W.b₂ * x₁ + 2 * W.b₄)),
        0, C (C y⁻¹) * (Y - W.negPolynomial), ?_⟩, by
      rw [map_add, map_one, _root_.map_mul <| mk W, AdjoinRoot.mk_self, mul_zero,
        add_zero]⟩
    rw [polynomial, negPolynomial, ← mul_right_inj' <| C_ne_zero.mpr <| C_ne_zero.mpr hxy]
    simp only [mul_add, ← mul_assoc, ← C_mul, mul_inv_cancel hxy]
    linear_combination (norm := (rw [b₂, b₄, negY]; C_simp; 

Proof state:
case a
R : Type u
inst✝¹ : CommRing R
W✝ : Affine R
F : Type u
inst✝ : Field F
W : Affine F
x₁ y₁ : F
h₁ : W.equation x₁ y₁
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
h₂ : W.equation x₁ y₁
y : F := (y₁ - W.negY x₁ y₁) ^ 2
hxy : (y₁ - W.negY x₁ y₁) ^ 2 ≠ 0
⊢ 1 * (Y - (-Y - (C (C W.a₁) * C Y + C (C W.a₃)))) * (Y - (-Y - (C (C W.a₁) * C Y + C (C W.a₃)))) -
        ((C (C y₁) - (-C (C y₁) - C (C W.a₁) * C (C x₁) - C (C W.a₃))) ^ 2 * 1 +
              1 * 4 *
                (Y ^ 2 + (C (C W.a₁) * C Y + C (C W.a₃)) * Y -
                  (C Y ^ 3 + C (C W.a₂) * C Y ^ 2 + C (C W.a₄) * C Y + C (C W.a₆))) +
            (1 * 4 * C Y ^ 2 + (1 * 4 * C (C x₁) + 1 * (C (C W.a₁) ^ 2 + 4 * C (C W.a₂))) * C Y +
                (1 * 4 * C (C x₁) ^ 2 + 1 * (C (C W.a₁) ^ 2 + 4 * C (C W.a₂)) * C (C x₁) +
                  1 * 2 * (2 * C (C W.a₄) + C (C W.a₁) * C (C W.a₃)))) *
              (C Y - C (C x₁)) +
          (C (C y₁) - (-C (C y₁) - C (C W.a₁) * C (C x₁) - C (C W.a₃))) ^ 2 * 0 * (C Y - C (C x₁))) -
      (-4 * (C (C y₁) ^ 2 + C (C W.a₁) * C (C x₁) * C (C y₁) + C (C W.a₃) * C (C y₁)) -
        -4 * (C (C x₁) ^ 3 + C (C W.a₂) * C (C x₁) ^ 2 + C (C W.a₄) * C (C x₁) + C (C W.a₆))) =
    0

Next tactic:
ring1