/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import group_theory.group_action.defs

/-!
# Sigma instances for additive and multiplicative actions

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines instances for arbitrary sum of additive and multiplicative actions.

## See also

* `group_theory.group_action.pi`
* `group_theory.group_action.prod`
* `group_theory.group_action.sum`
-/

variables {ι : Type*} {M N : Type*} {α : ι → Type*}

namespace sigma

section has_smul
variables [Π i, has_smul M (α i)] [Π i, has_smul N (α i)] (a : M) (i : ι) (b : α i)
  (x : Σ i, α i)

@[to_additive sigma.has_vadd] instance : has_smul M (Σ i, α i) := ⟨λ a, sigma.map id $ λ i, (•) a⟩

@[to_additive]

@[to_additive] instance [has_smul M N] [Π i, is_scalar_tower M N (α i)] :
  is_scalar_tower M N (Σ i, α i) :=
⟨λ a b x, by { cases x, rw [smul_mk, smul_mk, smul_mk, smul_assoc] }⟩

@[to_additive] instance [Π i, smul_comm_class M N (α i)] : smul_comm_class M N (Σ i, α i) :=
⟨λ a b x, by { cases x, rw [smul_mk, smul_mk, smul_mk, smul_mk, smul_comm] }⟩

@[to_additive] instance [Π i, has_smul Mᵐᵒᵖ (α i)] [Π i, is_central_scalar M (α i)] :
  is_central_scalar M (Σ i, α i) :=
⟨λ a x, by { cases x, rw [smul_mk, smul_mk, op_smul_eq_smul] }⟩

/-- This is not an instance because `i` becomes a metavariable. -/
@[to_additive "This is not an instance because `i` becomes a metavariable."]
protected lemma has_faithful_smul' [has_faithful_smul M (α i)] : has_faithful_smul M (Σ i, α i) :=
⟨λ x y h, eq_of_smul_eq_smul $ λ a : α i, heq_iff_eq.1 (ext_iff.1 $ h $ mk i a).2⟩

@[to_additive] instance [nonempty ι] [Π i, has_faithful_smul M (α i)] :
  has_faithful_smul M (Σ i, α i) :=
nonempty.elim ‹_› $ λ i, sigma.has_faithful_smul' i

end has_smul

@[to_additive] instance {m : monoid M} [Π i, mul_action M (α i)] : mul_action M (Σ i, α i) :=
{ mul_smul := λ a b x, by { cases x, rw [smul_mk, smul_mk, smul_mk, mul_smul] },
  one_smul := λ x, by { cases x, rw [smul_mk, one_smul] } }

end sigma


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monad.algebra
import Mathlib.category_theory.adjunction.default
import Mathlib.PostPort

universes u₁ u₂ v₁ v₂ l

namespace Mathlib

namespace category_theory

namespace adjunction

@[simp] theorem monad_μ {C : Type u₁} [category C] {D : Type u₂} [category D] (R : D ⥤ C)
    [is_right_adjoint R] :
    μ_ = whisker_right (whisker_left (left_adjoint R) (counit (of_right_adjoint R))) R :=
  Eq.refl μ_

@[simp] theorem comonad_ε {C : Type u₁} [category C] {D : Type u₂} [category D] (L : C ⥤ D)
    [is_left_adjoint L] : ε_ = counit (of_left_adjoint L) :=
  Eq.refl ε_

end adjunction

namespace monad

/--
Gven any adjunction `L ⊣ R`, there is a comparison functor `category_theory.monad.comparison R`
sending objects `Y : D` to Eilenberg-Moore algebras for `L ⋙ R` with underlying object `R.obj X`.

We later show that this is full when `R` is full, faithful when `R` is faithful,
and essentially surjective when `R` is reflective.
-/
@[simp] theorem comparison_map_f {C : Type u₁} [category C] {D : Type u₂} [category D] (R : D ⥤ C)
    [is_right_adjoint R] (X : D) (Y : D) (f : X ⟶ Y) :
    algebra.hom.f (functor.map (comparison R) f) = functor.map R f :=
  Eq.refl (algebra.hom.f (functor.map (comparison R) f))

/--
The underlying object of `(monad.comparison R).obj X` is just `R.obj X`.
-/
def comparison_forget {C : Type u₁} [category C] {D : Type u₂} [category D] (R : D ⥤ C)
    [is_right_adjoint R] : comparison R ⋙ forget (left_adjoint R ⋙ R) ≅ R :=
  iso.mk (nat_trans.mk fun (X : D) => 𝟙) (nat_trans.mk fun (X : D) => 𝟙)

end monad

namespace comonad

/--
Gven any adjunction `L ⊣ R`, there is a comparison functor `category_theory.comonad.comparison L`
sending objects `X : C` to Eilenberg-Moore coalgebras for `L ⋙ R` with underlying object
`L.obj X`.
-/
@[simp] theorem comparison_obj_a {C : Type u₁} [category C] {D : Type u₂} [category D] (L : C ⥤ D)
    [is_left_adjoint L] (X : C) :
    coalgebra.a (functor.obj (comparison L) X) =
        functor.map L (nat_trans.app (adjunction.unit (adjunction.of_left_adjoint L)) X) :=
  Eq.refl (coalgebra.a (functor.obj (comparison L) X))

/--
The underlying object of `(comonad.comparison L).obj X` is just `L.obj X`.
-/
def comparison_forget {C : Type u₁} [category C] {D : Type u₂} [category D] (L : C ⥤ D)
    [is_left_adjoint L] : comparison L ⋙ forget (right_adjoint L ⋙ L) ≅ L :=
  iso.mk (nat_trans.mk fun (X : C) => 𝟙) (nat_trans.mk fun (X : C) => 𝟙)

end comonad

/--
A right adjoint functor `R : D ⥤ C` is *monadic* if the comparison functor `monad.comparison R`
from `D` to the category of Eilenberg-Moore algebras for the adjunction is an equivalence.
-/
class monadic_right_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (R : D ⥤ C)
    extends is_right_adjoint R where
  eqv : is_equivalence (monad.comparison R)

/--
A left adjoint functor `L : C ⥤ D` is *comonadic* if the comparison functor `comonad.comparison L`
from `C` to the category of Eilenberg-Moore algebras for the adjunction is an equivalence.
-/
class comonadic_left_adjoint {C : Type u₁} [category C] {D : Type u₂} [category D] (L : C ⥤ D)
    extends is_left_adjoint L where
  eqv : is_equivalence (comonad.comparison L)

-- TODO: This holds more generally for idempotent adjunctions, not just reflective adjunctions.

protected instance μ_iso_of_reflective {C : Type u₁} [category C] {D : Type u₂} [category D]
    (R : D ⥤ C) [reflective R] : is_iso μ_ :=
  id
    (category_theory.is_iso_whisker_right
      (whisker_left (left_adjoint R) (adjunction.counit (adjunction.of_right_adjoint R))) R)

namespace reflective

protected instance app.category_theory.is_iso {C : Type u₁} [category C] {D : Type u₂} [category D]
    (R : D ⥤ C) [reflective R] (X : monad.algebra (left_adjoint R ⋙ R)) :
    is_iso (nat_trans.app (adjunction.unit (adjunction.of_right_adjoint R)) (monad.algebra.A X)) :=
  is_iso.mk (monad.algebra.a X)

protected instance comparison_ess_surj {C : Type u₁} [category C] {D : Type u₂} [category D]
    (R : D ⥤ C) [reflective R] : ess_surj (monad.comparison R) :=
  sorry

protected instance comparison_full {C : Type u₁} [category C] {D : Type u₂} [category D] (R : D ⥤ C)
    [full R] [is_right_adjoint R] : full (monad.comparison R) :=
  full.mk
    fun (X Y : D) (f : functor.obj (monad.comparison R) X ⟶ functor.obj (monad.comparison R) Y) =>
      functor.preimage R (monad.algebra.hom.f f)

protected instance comparison_faithful {C : Type u₁} [category C] {D : Type u₂} [category D]
    (R : D ⥤ C) [faithful R] [is_right_adjoint R] : faithful (monad.comparison R) :=
  faithful.mk

end reflective

-- It is possible to do this computably since the construction gives the data of the inverse, not

-- just the existence of an inverse on each object.

/-- Any reflective inclusion has a monadic right adjoint.
    cf Prop 5.3.3 of [Riehl][riehl2017] -/
protected instance monadic_of_reflective {C : Type u₁} [category C] {D : Type u₂} [category D]
    (R : D ⥤ C) [reflective R] : monadic_right_adjoint R :=
  monadic_right_adjoint.mk
    (equivalence.equivalence_of_fully_faithfully_ess_surj (monad.comparison R))

end Mathlib


example (p q r s : Prop) :
  p → q → r → s → (p ∧ q) ∧ (r ∧ s ∧ p) ∧ (p ∧ r ∧ q) :=
begin
  intros; repeat { constructor }; assumption
end


import S5.syntax.lemmas
import S5.semantics.lemmas

theorem soundness { Γ : ctx } { p : form } : (Γ ⊢ₛ₅ p) → (Γ ⊩ₛ₅ p) := by
  intro h
  induction h
  {
    apply sem_csq.is_true;
    intros;
    apply ctx_tt_to_mem_tt;
    repeat assumption
  }
  {
    apply sem_csq.is_true;
    intros;
    apply is_true_pl1;
    repeat assumption
  }
  {
    apply sem_csq.is_true;
    intros;
    apply is_true_pl2;
    repeat assumption
  }
  {
    apply sem_csq.is_true;
    intros;
    apply is_true_pl3;
    repeat assumption
  }
  {
    sorry
    -- cazul mp
  }
  {
    apply sem_csq.is_true;
    intros;
    apply is_true_k;
    repeat assumption
  }
  {
    apply sem_csq.is_true;
    intros;
    apply is_true_t;
    repeat assumption
  }
  {
    apply sem_csq.is_true;
    intros;
    apply is_true_s4;
    repeat assumption
  }
  {
    sorry
    -- trebuie scris is_true_s5
  }
  {
    apply sem_csq.is_true;
    intros;
    unfold forces_form; simp;
    rename_i h_ih;
    sorry;
    sorry;
    -- induction h_ih;
    -- intros;
    -- apply h_ih;
    -- assumption;
    -- apply empty_ctx_tt;
  }


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.metric_space.basic
import Mathlib.topology.algebra.uniform_group
import Mathlib.topology.algebra.ring
import Mathlib.topology.algebra.continuous_functions
import Mathlib.ring_theory.subring
import Mathlib.group_theory.archimedean
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Topological properties of ℝ
-/

protected instance rat.metric_space : metric_space ℚ :=
  metric_space.induced coe sorry real.metric_space

theorem rat.dist_eq (x : ℚ) (y : ℚ) : dist x y = abs (↑x - ↑y) :=
  rfl

@[simp] theorem rat.dist_cast (x : ℚ) (y : ℚ) : dist ↑x ↑y = dist x y :=
  rfl

-- we want to ignore this instance for the next declaration

protected instance int.metric_space : metric_space ℤ :=
  let M : metric_space ℤ := metric_space.induced coe sorry real.metric_space;
  metric_space.replace_uniformity M sorry

theorem int.dist_eq (x : ℤ) (y : ℤ) : dist x y = abs (↑x - ↑y) :=
  rfl

@[simp] theorem int.dist_cast_real (x : ℤ) (y : ℤ) : dist ↑x ↑y = dist x y :=
  rfl

@[simp] theorem int.dist_cast_rat (x : ℤ) (y : ℤ) : dist ↑x ↑y = dist x y := sorry

theorem uniform_continuous_of_rat : uniform_continuous coe :=
  uniform_continuous_comap

theorem uniform_embedding_of_rat : uniform_embedding coe :=
  uniform_embedding_comap rat.cast_injective

theorem dense_embedding_of_rat : dense_embedding coe := sorry

theorem embedding_of_rat : embedding coe :=
  dense_embedding.to_embedding dense_embedding_of_rat

theorem continuous_of_rat : continuous coe :=
  uniform_continuous.continuous uniform_continuous_of_rat

theorem real.uniform_continuous_add : uniform_continuous fun (p : ℝ × ℝ) => prod.fst p + prod.snd p := sorry

-- TODO(Mario): Find a way to use rat_add_continuous_lemma

theorem rat.uniform_continuous_add : uniform_continuous fun (p : ℚ × ℚ) => prod.fst p + prod.snd p := sorry

theorem real.uniform_continuous_neg : uniform_continuous Neg.neg := sorry

theorem rat.uniform_continuous_neg : uniform_continuous Neg.neg := sorry

protected instance real.uniform_add_group : uniform_add_group ℝ :=
  uniform_add_group.mk' real.uniform_continuous_add real.uniform_continuous_neg

protected instance rat.uniform_add_group : uniform_add_group ℚ :=
  uniform_add_group.mk' rat.uniform_continuous_add rat.uniform_continuous_neg

protected instance real.topological_add_group : topological_add_group ℝ :=
  linear_ordered_add_comm_group.topological_add_group

protected instance rat.topological_add_group : topological_add_group ℚ :=
  uniform_add_group.to_topological_add_group

protected instance rat.order_topology : order_topology ℚ :=
  induced_order_topology coe (fun (x y : ℚ) => rat.cast_lt) exists_rat_btwn

theorem real.is_topological_basis_Ioo_rat : topological_space.is_topological_basis
  (set.Union fun (a : ℚ) => set.Union fun (b : ℚ) => set.Union fun (h : a < b) => singleton (set.Ioo ↑a ↑b)) := sorry

protected instance real.topological_space.second_countable_topology : topological_space.second_countable_topology ℝ := sorry

/- TODO(Mario): Prove that these are uniform isomorphisms instead of uniform embeddings
lemma uniform_embedding_add_rat {r : ℚ} : uniform_embedding (λp:ℚ, p + r) :=
_

lemma uniform_embedding_mul_rat {q : ℚ} (hq : q ≠ 0) : uniform_embedding ((*) q) :=
_ -/

theorem real.mem_closure_iff {s : set ℝ} {x : ℝ} : x ∈ closure s ↔ ∀ (ε : ℝ) (H : ε > 0), ∃ (y : ℝ), ∃ (H : y ∈ s), abs (y - x) < ε := sorry

theorem real.uniform_continuous_inv (s : set ℝ) {r : ℝ} (r0 : 0 < r) (H : ∀ (x : ℝ), x ∈ s → r ≤ abs x) : uniform_continuous fun (p : ↥s) => subtype.val p⁻¹ := sorry

theorem real.uniform_continuous_abs : uniform_continuous abs :=
  iff.mpr metric.uniform_continuous_iff
    fun (ε : ℝ) (ε0 : ε > 0) =>
      Exists.intro ε (Exists.intro ε0 fun (a b : ℝ) => lt_of_le_of_lt (abs_abs_sub_abs_le_abs_sub a b))

theorem rat.uniform_continuous_abs : uniform_continuous abs := sorry

theorem real.tendsto_inv {r : ℝ} (r0 : r ≠ 0) : filter.tendsto (fun (q : ℝ) => q⁻¹) (nhds r) (nhds (r⁻¹)) := sorry

theorem real.continuous_inv : continuous fun (a : Subtype fun (r : ℝ) => r ≠ 0) => subtype.val a⁻¹ := sorry

theorem real.continuous.inv {α : Type u} [topological_space α] {f : α → ℝ} (h : ∀ (a : α), f a ≠ 0) (hf : continuous f) : continuous fun (a : α) => f a⁻¹ :=
  (fun (this : continuous ((has_inv.inv ∘ subtype.val) ∘ fun (a : α) => { val := f a, property := h a })) => this)
    (continuous.comp real.continuous_inv (continuous_subtype_mk (fun (a : α) => h a) hf))

theorem real.uniform_continuous_mul_const {x : ℝ} : uniform_continuous (Mul.mul x) := sorry

theorem real.uniform_continuous_mul (s : set (ℝ × ℝ)) {r₁ : ℝ} {r₂ : ℝ} (H : ∀ (x : ℝ × ℝ), x ∈ s → abs (prod.fst x) < r₁ ∧ abs (prod.snd x) < r₂) : uniform_continuous fun (p : ↥s) => prod.fst (subtype.val p) * prod.snd (subtype.val p) := sorry

protected theorem real.continuous_mul : continuous fun (p : ℝ × ℝ) => prod.fst p * prod.snd p := sorry

protected instance real.topological_ring : topological_ring ℝ :=
  topological_ring.mk continuous_neg

protected instance real.topological_semiring : topological_semiring ℝ :=
  topological_ring.to_topological_semiring ℝ

theorem rat.continuous_mul : continuous fun (p : ℚ × ℚ) => prod.fst p * prod.snd p := sorry

protected instance rat.topological_ring : topological_ring ℚ :=
  topological_ring.mk continuous_neg

theorem real.ball_eq_Ioo (x : ℝ) (ε : ℝ) : metric.ball x ε = set.Ioo (x - ε) (x + ε) := sorry

theorem real.Ioo_eq_ball (x : ℝ) (y : ℝ) : set.Ioo x y = metric.ball ((x + y) / bit0 1) ((y - x) / bit0 1) := sorry

theorem real.totally_bounded_Ioo (a : ℝ) (b : ℝ) : totally_bounded (set.Ioo a b) := sorry

theorem real.totally_bounded_ball (x : ℝ) (ε : ℝ) : totally_bounded (metric.ball x ε) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (totally_bounded (metric.ball x ε))) (real.ball_eq_Ioo x ε)))
    (real.totally_bounded_Ioo (x - ε) (x + ε))

theorem real.totally_bounded_Ico (a : ℝ) (b : ℝ) : totally_bounded (set.Ico a b) := sorry

theorem real.totally_bounded_Icc (a : ℝ) (b : ℝ) : totally_bounded (set.Icc a b) := sorry

theorem rat.totally_bounded_Icc (a : ℚ) (b : ℚ) : totally_bounded (set.Icc a b) := sorry

protected instance real.complete_space : complete_space ℝ := sorry

theorem closure_of_rat_image_lt {q : ℚ} : closure (coe '' set_of fun (x : ℚ) => q < x) = set_of fun (r : ℝ) => ↑q ≤ r := sorry

/- TODO(Mario): Put these back only if needed later
lemma closure_of_rat_image_le_eq {q : ℚ} : closure ((coe:ℚ → ℝ) '' {x | q ≤ x}) = {r | ↑q ≤ r} :=
_

lemma closure_of_rat_image_le_le_eq {a b : ℚ} (hab : a ≤ b) :
  closure (of_rat '' {q:ℚ | a ≤ q ∧ q ≤ b}) = {r:ℝ | of_rat a ≤ r ∧ r ≤ of_rat b} :=
_-/

theorem compact_Icc {a : ℝ} {b : ℝ} : is_compact (set.Icc a b) :=
  compact_of_totally_bounded_is_closed (real.totally_bounded_Icc a b)
    (is_closed_inter (is_closed_ge' a) (is_closed_le' b))

theorem compact_pi_Icc {ι : Type u_1} {a : ι → ℝ} {b : ι → ℝ} : is_compact (set.Icc a b) :=
  Eq.subst (set.pi_univ_Icc a b) compact_univ_pi fun (i : ι) => compact_Icc

protected instance real.proper_space : proper_space ℝ :=
  proper_space.mk
    fun (x r : ℝ) => eq.mpr (id (Eq._oldrec (Eq.refl (is_compact (metric.closed_ball x r))) closed_ball_Icc)) compact_Icc

theorem real.bounded_iff_bdd_below_bdd_above {s : set ℝ} : metric.bounded s ↔ bdd_below s ∧ bdd_above s := sorry

theorem real.image_Icc {f : ℝ → ℝ} {a : ℝ} {b : ℝ} (hab : a ≤ b) (h : continuous_on f (set.Icc a b)) : f '' set.Icc a b = set.Icc (Inf (f '' set.Icc a b)) (Sup (f '' set.Icc a b)) := sorry

protected instance reals_semimodule : topological_semimodule ℝ ℝ :=
  topological_semimodule.mk continuous_mul

protected instance real_maps_algebra {α : Type u_1} [topological_space α] : algebra ℝ (continuous_map α ℝ) :=
  Mathlib.continuous_map_algebra

/-- Given a nontrivial subgroup `G ⊆ ℝ`, if `G ∩ ℝ_{>0}` has no minimum then `G` is dense. -/
theorem real.subgroup_dense_of_no_min {G : add_subgroup ℝ} {g₀ : ℝ} (g₀_in : g₀ ∈ G) (g₀_ne : g₀ ≠ 0) (H' : ¬∃ (a : ℝ), is_least (set_of fun (g : ℝ) => g ∈ G ∧ 0 < g) a) : dense ↑G := sorry

/-- Subgroups of `ℝ` are either dense or cyclic. See `real.subgroup_dense_of_no_min` and
`subgroup_cyclic_of_min` for more precise statements. -/
theorem real.subgroup_dense_or_cyclic (G : add_subgroup ℝ) : dense ↑G ∨ ∃ (a : ℝ), G = add_subgroup.closure (singleton a) := sorry


import basic_defs_world.level1 -- hide
import tactic -- hide

/-
# Level 1: The identity function is continuous

In this level we prove that the identity function is continuous.

-/

/- Definition : A function between two topologies is continuous if the preimage of an open set is an open set.
-/

open set -- hide
open topological_space -- hide
variables {X Y: Type} [topological_space X] -- hide

/- Lemma
The idententiy function is continuous.
-/
lemma id_is_continuous (f : X → X) : continuous (λ x: X, x) :=
begin
  intros V hV,
  unfold preimage,
  rw set_of_mem_eq,
  exact hV,

end


import data.stream

import temporal_logic

import util.logic
import util.predicate
import util.data.fin

namespace unitb

universe variable u

open predicate
open temporal (hiding action)

@[reducible]
def pred (σ : Sort u) := pred' σ

-- instance {σ} : has_coe (pred σ) (pred' σ) :=
-- by { unfold pred, apply_instance }

class has_safety (α : Sort u) : Type u :=
  (σ : Sort u)
  (step : α → σ → σ → Prop)

def state := has_safety.σ

def step {α} [has_safety α] : α → act (state α) :=
has_safety.step

def unless {α} [has_safety α] (s : α) (p q : pred' (state α)) : Prop :=
∀ σ σ', step s σ σ' → σ ⊨ p ∧ ¬ σ ⊨ q → σ' ⊨ p ∨ σ' ⊨ q

def co {α} [has_safety α] (s : α) (p q : pred' (state α)) : Prop :=
∀ σ σ', step s σ σ' → σ ⊨ p → σ' ⊨ q

def co' {α} [has_safety α] (s : α) (r : act (state α)) : Prop :=
∀ σ σ', step s σ σ' → r σ σ'

def unless' {α} [has_safety α] (s : α) (p q : pred' (state α)) (e : act (state α)) : Prop :=
∀ σ σ', step s σ σ' → ¬ e σ σ' → σ ⊨ p ∧ ¬ σ ⊨ q → σ' ⊨ p ∨ σ' ⊨ q

lemma unless_eq_unless_except {α} [has_safety α] (s : α) (p q : pred' (state α))
: unless s p q = unless' s p q (λ _ _, false) :=
begin
  unfold unless unless',
  apply forall_congr_eq, intro σ,
  apply forall_congr_eq, intro σ',
  apply forall_congr_eq, intro P,
  generalize : (σ ⊨ p ∧ ¬ σ ⊨ q → σ' ⊨ p ∨ σ' ⊨ q) = r,
  simp,
end

def saf_ex {α} [has_safety α] (s : α) : cpred (state α) :=
 (◻ ⟦ step s ⟧)

section properties

open predicate

parameter {α : Type u}
variable [has_safety α]
variable s : α
def σ := state α
variables {s}

lemma unless_action' {α} [has_safety α] {s : α} {p q : pred' (state α)} {e : act $ state α}
  (h : unless' s p q e)
: ⟦ λ σ σ', (σ ⊨ p ∧ ¬ σ ⊨ q) ⟧ ⟹ ( ⟦ step s ⟧ ⟶ -⟦ e ⟧ ⟶ ⟦ λ _ σ', σ' ⊨ p ∨ σ' ⊨ q ⟧ ) :=
begin [temporal]
  action with σ σ'
  { intros, apply h ; assumption, },
end

lemma unless_action {α} [has_safety α] {s : α} {p q : pred' (state α)}
  (h : unless s p q)
: ⟦ λ σ σ', (σ ⊨ p ∧ ¬ σ ⊨ q) ⟧ ⟹ ( ⟦ step s ⟧ ⟶  ⟦ λ _ σ', σ' ⊨ p ∨ σ' ⊨ q ⟧ ) :=
begin
  rw ← action_imp,
  refine action_entails_action _ _ _ ,
  intros s s' hpnq act,
  apply h _ _ act hpnq
end

section
open tactic interactive

meta def classical_rules : list simp_arg_type :=
[simp_arg_type.expr ``(not_or_iff_not_and_not)
,simp_arg_type.expr ``(classical.not_and_iff_not_or_not)
,simp_arg_type.expr ``(not_not_iff_self)]

meta def tactic.classical_simp (rules : parse simp_arg_list) : tactic unit :=
tactic.interactive.simp ff (classical_rules ++ rules) [`predicate] loc.wildcard

meta def tactic.safety_intro (rules : list simp_arg_type) (with_contra : bool := ff) : tactic unit :=
do `(unless _ _ _) ← target,
   σ  ← intro1,
   σ' ← intro1,
   STEP ← intro1,
   hs ← local_context,
   hs.for_each (λ h, try $ do
     `(unless _ _ _) ← infer_type h,
     note h.local_pp_name none (h σ σ' STEP),
     clear h),
   clear STEP,
   when with_contra (() <$ by_contradiction),
   tactic.classical_simp rules

meta def tactic.prove_safety (rs : parse simp_arg_list) : tactic unit :=
do tactic.safety_intro rs,
   try `[begin [smt] intros, break_asms ; by_contradiction ; eblast end]

meta def tactic.prove_safety_with_contra (rs : parse simp_arg_list) : tactic unit :=
do tactic.safety_intro rs tt,
   try `[begin [smt] intros, break_asms ; by_contradiction ; eblast end]

run_cmd add_interactive
   [`tactic.prove_safety
   ,`tactic.safety_intro
   ,`tactic.prove_safety_with_contra
   ,`tactic.classical_simp]

end

lemma unless_imp {p q : pred' σ} (h : p ⟹ q) : unless s p q :=
begin
  intros σ σ' h₀ h₁,
  cases h₁ with h₁ h₂,
  exfalso,
  apply h₂, apply entails_to_pointwise h _ h₁,
end

lemma unless_weak_rhs {p q r : pred' σ}
  (h : q ⟹ r)
  (P₀ : unless s p q)
: unless s p r :=
begin
  revert P₀, unfold unless,
  intros_mono s s' step,
  apply imp_mono,
  { apply and.imp id,
    apply imp_imp_imp_left,
    apply ew_str h },
  { apply or.imp_right,
    apply ew_str h }
end

local attribute [instance] classical.prop_decidable

lemma unless_conj_gen {p₀ q₀ p₁ q₁ : pred' σ}
  (P₀ : unless s p₀ q₀)
  (P₁ : unless s p₁ q₁)
: unless s (p₀ ⋀ p₁) ((q₀ ⋀ p₁) ⋁ (p₀ ⋀ q₁) ⋁ (q₀ ⋀ q₁)) :=
by prove_safety [imp_iff_not_or]

theorem unless_conj {p₀ q₀ p₁ q₁ : pred' (state α)}
  (h₀ : unless s p₀ q₀)
  (h₁ : unless s p₁ q₁)
: unless s (p₀ ⋀ p₁) (q₀ ⋁ q₁) :=
by prove_safety

lemma unless_disj_gen {p₀ q₀ p₁ q₁ : pred' σ}
  (P₀ : unless s p₀ q₀)
  (P₁ : unless s p₁ q₁)
: unless s (p₀ ⋁ p₁) ((q₀ ⋀ - p₁) ⋁ (- p₀ ⋀ q₁) ⋁ (q₀ ⋀ q₁)) :=
by prove_safety

lemma unless_disj' {p₀ q₀ p₁ q₁ : pred' σ}
  (P₀ : unless s p₀ q₀)
  (P₁ : unless s p₁ q₁)
: unless s (p₀ ⋁ p₁) (q₀ ⋁ q₁) :=
by prove_safety

@[refl]
lemma unless_refl (p : pred' (state α)) : unless s p p :=
by prove_safety

lemma unless_antirefl (p : pred' (state α)) : unless s p (-p) :=
by prove_safety

@[simp]
lemma True_unless (p : pred' (state α)) : unless s True p :=
by prove_safety

lemma unless_cancellation {p q r : pred' (state α)}
  (S₀ : unless s p q)
  (S₁ : unless s q r)
: unless s (p ⋁ q) r :=
by prove_safety

lemma exists_unless' {t} {p : t → pred' (state α)} {q : pred' (state α)}
  {A : act (state α)}
  (h : ∀ i, unless' s (p i) q A)
: unless' s (∃∃ i, p i) q A :=
begin
  intros σ σ' STEP Hact,
  apply and.rec,
  intros h₀ h₁, cases h₀ with x h₀,
  have h₂ := h x _ _ STEP Hact ⟨h₀,h₁⟩,
  apply or.imp_left _ h₂,
  apply Exists.intro x,
end

lemma exists_unless {t} {p : t → pred' (state α)} {q : pred' (state α)}
  (h : ∀ i, unless s (p i) q)
: unless s (∃∃ i, p i) q :=
begin
  rw unless_eq_unless_except,
  apply exists_unless',
  intro,
  rw [← unless_eq_unless_except],
  apply h
end

lemma forall_unless_exists_str {n} {p q : fin n → pred' (state α)}
  (h : ∀ i, unless s (p i) (p i ⋀ q i))
: unless s (∀∀ i, p i) ( (∀∀ i, p i) ⋀ (∃∃ i, q i) ) :=
begin
  revert p q h,
  induction n with n IH
  ; intros p q h,
  { rw p_forall_fin_zero, apply True_unless, },
  { rw [p_exists_split_one,p_forall_split_one],
    have h' : ∀ i, unless s (restr p i) (restr p i ⋀ restr q i),
    { unfold restr, intro i, apply h },
    have Hconj := unless_conj_gen (h fin.max) (IH h'),
    apply unless_weak_rhs _ Hconj, clear Hconj,
    { lifted_pred,
      begin [smt] intros, break_asms end, } },
end

lemma forall_unless_exists {n} {p q : fin n → pred' (state α)}
  (h : ∀ i, unless s (p i) (q i))
: unless s (∀∀ i, p i) (∃∃ i, q i) :=
begin
  revert p q h,
  induction n with n IH
  ; intros p q h,
  { rw p_forall_fin_zero, apply True_unless, },
  { rw [p_exists_split_one,p_forall_split_one],
    have h' : ∀ i, unless s (restr p i) (restr q i),
    { unfold restr, intro i, apply h },
    have Hconj := unless_conj_gen (h fin.max) (IH h'),
    apply unless_weak_rhs _ Hconj, clear Hconj,
    { propositional } },
end

lemma forall_unless {n} {p : fin n → pred' (state α)} {b : pred' (state α)}
  (h : ∀ i, unless s (p i) b)
: unless s (∀∀ i, p i) b :=
begin
  have h : unless s (∀∀ i, p i) (∃∃ i : fin n, b) := forall_unless_exists h,
  apply unless_weak_rhs _ h,
  pointwise with x, simp,
end

open nat temporal stream

instance persistent_saf_ex : persistent (saf_ex s) :=
by { unfold saf_ex, apply_instance }

variables {Γ : cpred σ}

lemma unless_sem {p q : pred' σ}
    (sem : Γ ⊢ saf_ex s)
    (H : unless s p q)
    (h : Γ ⊢ •p)
:  Γ ⊢ ◻•p ⋁ ◇•q :=
begin [temporal]
  focus_left with H',
  { simp [p_not_eq_not,not_eventually] at H' ,
    revert h,
    apply induct (•p) _ _,
    henceforth at sem ⊢,
    intros hp,
    have hq  : -•q, apply H',
    have hq' : ⊙-•q, apply H',
    have := unless_action H Γ _ sem,
    { revert this hq hq',
      clear H,
      action with σ σ'
      { begin [smt] intros, break_asms,
                    exact a_1, destruct σ_1 a_1 , end } },
    revert hp hq hq',
    action with σ σ'
    { intros,
      by_contradiction, classical_simp,
      begin [smt] break_asms,
                  apply σ'_1 a_2,
                  apply a_2 a, end }, }
end

lemma co_sem' {A : act σ}
    (sem : Γ ⊢ saf_ex s)
    (H : co' s A)
: Γ ⊢ ◻⟦ A ⟧ :=
begin [temporal]
  henceforth at *,
  revert sem,
  action
  { apply H, },
end

lemma unless_sem_str {p q : pred' σ}
    (sem : Γ ⊢ saf_ex s)
    (H₀ : unless s p q)
    (H₁ : Γ ⊢ ◻◇•p)
: Γ ⊢ ◇◻•p ⋁ ◻◇•q :=
begin [temporal]
  rw [← p_not_p_imp,not_eventually],
  intro H₂,
  henceforth at H₁ ⊢,
  eventually H₁,
  henceforth at H₂,
  revert H₂, rw p_not_p_imp,
  apply unless_sem sem H₀ H₁,
end

lemma unless_sem_exists' {t} {p : t → pred' σ} {q : pred' σ} {evt : act σ}
    (sem : Γ ⊢ saf_ex s)
    (H : ∀ x, unless' s (p x) q evt)
: Γ ⊢ ◻◇(∃∃ x, •p x) ⟶ (∃∃ x, ◇◻•p x) ⋁ ◻◇(•q ⋁ ⟦ evt ⟧) :=
begin [temporal]
  intro H₀,
  rw [p_or_comm,← p_not_p_imp],
  intro H₁,
  simp [p_not_p_exists] at H₁,
  rw ← eventually_exists,
  eventually H₁,
  henceforth at H₀,
  eventually H₀ ⊢,
  revert H₀,
  apply p_exists_p_imp_p_exists,
  introv,
  apply induct,
  henceforth at sem ⊢,
  intro hp,
  simp [p_not_p_or] at H₁,
  have Hnq : -•q,
  { strengthen_to ◻_, persistent,
    henceforth at H₁ ⊢, apply H₁.left, },
  have Hnnq : ⊙-•q,
  { strengthen_to ◻-_, persistent,
    henceforth at H₁ ⊢, apply H₁.left, },
  have Hevt : -⟦ evt ⟧,
  { strengthen_to ◻_, persistent,
    henceforth at H₁ ⊢, apply H₁.right, },
  clear H₁,
  have := unless_action' (H x) Γ,
  revert sem hp Hnq Hnnq Hevt this,
  clear H,
  action with h₀ h₁ h₂ h₃ h₄ h₅
  { specialize h₀ ⟨h₄,h₃⟩ h₅ h₁,
    begin [smt] break_asms, destruct h₂ a, end },
end

lemma unless_sem_exists {t} {p : t → pred' σ} {q : pred' σ}
    (sem : Γ ⊢ saf_ex s)
    (H : ∀ x, unless s (p x) q)
: Γ ⊢ ◻◇(∃∃ x, •p x) ⟶ (∃∃ x, ◇◻•p x) ⋁ ◻◇•q  :=
begin [temporal]
  intros H',
  simp [unless_eq_unless_except] at H,
  have := @unless_sem_exists' _ _ _ _ t p q _ sem H H',
  revert this,
  monotonicity,
  simp [@action_false (state α)],
end

end properties

end unitb


import verification.semantics.stream_props

variables {α ι₁ ι₂ : Type}

section streams

@[simps]
def substream (s : Stream (ι₁ × ι₂) α) (i₁ : ι₁) : Stream ι₂ α :=
{ σ := s.σ,
  valid := λ p, ∃ (h : s.valid p), (s.index p h).1 = i₁,
  ready := λ p, s.ready p,
  next := λ p h, s.next p h.fst,
  index := λ p h, (s.index p h.fst).2,
  value := λ p h, s.value p h,
}

variables {s : Stream (ι₁ × ι₂) α} {i₁ : ι₁}

@[simp] lemma substream.next'_eq {x : s.σ} :
(substream s i₁).valid x → (substream s i₁).next' x = s.next' x :=
λ h, by rw [Stream.next'_val h, substream_next, Stream.next'_val]

lemma substream.valid_subsumes {n : ℕ} {x : s.σ} :
(substream s i₁).valid ((substream s i₁).next'^[n] x) → s.valid (s.next'^[n] x) :=
begin
  induction n with n ih generalizing x,
  { simp only [function.iterate_zero, substream_valid],
    exact Exists.fst },
  { intro h,
    have hxv := Stream.next'_valid' _ h,
    rw [function.iterate_succ_apply] at h,
    simpa [hxv] using ih h }
end

lemma substream.bound_valid {B : ℕ} {x : s.σ} :
s.bound_valid B x → ∀ i₁, (substream s i₁).bound_valid B x :=
begin
  simp_rw bound_valid_iff_next'_iterate,
  induction B with n ih generalizing x,
  { simp_rw [function.iterate_zero_apply, substream_valid, not_exists],
    intros; contradiction },
  { intros hnv _,
    exact mt substream.valid_subsumes hnv }
end

end streams

section stream_exec

structure split_state (s : StreamExec (ι₁ × ι₂) α) :=
(state : s.stream.σ)
(last : option ι₁)
(remaining : ℕ)
(bound_valid : s.stream.bound_valid remaining state)

@[simps]
def Stream.split (s : StreamExec (ι₁ × ι₂) α) : Stream ι₁ (StreamExec ι₂ α) :=
{ σ := split_state s,
  valid := λ p, s.stream.valid p.1,
  ready := λ p, s.stream.ready p.1 ∧
                ∃ hv, p.last ≠ (s.stream.index p.1 hv).1,
  next := λ p h, ⟨s.stream.next p.1 h,
                  (s.stream.index p.1 h).1,
                  p.remaining.pred,
                  show s.stream.bound_valid p.remaining.pred _, by {
                    apply Stream.bound_valid_succ.1,
                    cases hp : p.remaining,
                    { have := p.bound_valid, rw hp at this,
                      cases this, contradiction, },
                    { simpa [hp] using p.bound_valid }
                  }⟩,
  index := λ p h, (s.stream.index p.1 h).1,
  value := λ p h, {
    stream := substream s.stream (s.stream.index p.1 h.2.fst).1,
    state := p.1,
    bound := p.remaining,
    bound_valid := substream.bound_valid p.bound_valid _,
  },
}

variables {s : StreamExec (ι₁ × ι₂) α}

@[simp] lemma Stream.split_next'_state (p : split_state s) :
((Stream.split s).next' p).state = s.stream.next' p.state :=
by { by_cases H : s.stream.valid p.state, { simpa [H] }, { simp [H] } }

@[simp] lemma Stream.split_next'_state' (x : split_state s) (n) :
((Stream.split s).next'^[n] x).state = (s.stream.next'^[n] x.state) :=
begin
  induction n with _ ih generalizing x,
  { simp },
  { simp_rw [function.iterate_succ_apply, ← Stream.split_next'_state],
    exact ih _ }
end

def StreamExec.split (s : StreamExec (ι₁ × ι₂) α) : StreamExec ι₁ (StreamExec ι₂ α) :=
{ stream := Stream.split s,
  state := ⟨s.state, none, s.bound, s.bound_valid⟩,
  bound := s.bound,
  bound_valid := begin
    have bv := s.bound_valid,
    rw bound_valid_iff_next'_iterate at ⊢ bv,
    induction eq : s.bound; simpa [eq] using bv,
  end,
}

variables [add_comm_monoid α]

/-
TODOs:
- do we need a no-lookback hypothesis for `i₁`?
 -/

theorem StreamExec.split.spec (i₁ i₂) :
(StreamExec.eval <$₂> StreamExec.split s).eval i₁ i₂ = s.eval (i₁, i₂) :=
sorry

end stream_exec


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.types
import category_theory.limits.shapes.products
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.terminal
import category_theory.concrete_category.basic
import tactic.elementwise

/-!
# Special shapes for limits in `Type`.

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

The general shape (co)limits defined in `category_theory.limits.types`
are intended for use through the limits API,
and the actual implementation should mostly be considered "sealed".

In this file, we provide definitions of the "standard" special shapes of limits in `Type`,
giving the expected definitional implementation:
* the terminal object is `punit`
* the binary product of `X` and `Y` is `X × Y`
* the product of a family `f : J → Type` is `Π j, f j`
* the coproduct of a family `f : J → Type` is `Σ j, f j`
* the binary coproduct of `X` and `Y` is the sum type `X ⊕ Y`
* the equalizer of a pair of maps `(g, h)` is the subtype `{x : Y // g x = h x}`
* the coequalizer of a pair of maps `(f, g)` is the quotient of `Y` by `∀ x : Y, f x ~ g x`
* the pullback of `f : X ⟶ Z` and `g : Y ⟶ Z` is the subtype `{ p : X × Y // f p.1 = g p.2 }`
  of the product

We first construct terms of `is_limit` and `limit_cone`, and then provide isomorphisms with the
types generated by the `has_limit` API.

As an example, when setting up the monoidal category structure on `Type`
we use the `types_has_terminal` and `types_has_binary_products` instances.
-/

universes u v

open category_theory
open category_theory.limits

namespace category_theory.limits.types

local attribute [tidy] tactic.discrete_cases

/-- A restatement of `types.lift_π_apply` that uses `pi.π` and `pi.lift`. -/
@[simp]
lemma pi_lift_π_apply
  {β : Type u} (f : β → Type u) {P : Type u} (s : Π b, P ⟶ f b) (b : β) (x : P) :
  (pi.π f b : (∏ f) → f b) (@pi.lift β _ _ f _ P s x) = s b x :=
congr_fun (limit.lift_π (fan.mk P s) ⟨b⟩) x

/-- A restatement of `types.map_π_apply` that uses `pi.π` and `pi.map`. -/
@[simp]
lemma pi_map_π_apply {β : Type u} {f g : β → Type u} (α : Π j, f j ⟶ g j) (b : β) (x) :
  (pi.π g b : (∏ g) → g b) (pi.map α x) = α b ((pi.π f b : (∏ f) → f b) x) :=
limit.map_π_apply _ _ _

/-- The category of types has `punit` as a terminal object. -/
def terminal_limit_cone : limits.limit_cone (functor.empty (Type u)) :=
{ cone :=
  { X := punit,
    π := by tidy, },
  is_limit := by tidy, }

/-- The terminal object in `Type u` is `punit`. -/
noncomputable def terminal_iso : ⊤_ (Type u) ≅ punit :=
limit.iso_limit_cone terminal_limit_cone

/-- The terminal object in `Type u` is `punit`. -/
noncomputable
def is_terminal_punit : is_terminal (punit : Type u) :=
terminal_is_terminal.of_iso terminal_iso

/-- The category of types has `pempty` as an initial object. -/
def initial_colimit_cocone : limits.colimit_cocone (functor.empty (Type u)) :=
{ cocone :=
  { X := pempty,
    ι := by tidy, },
  is_colimit := by tidy, }

/-- The initial object in `Type u` is `pempty`. -/
noncomputable def initial_iso : ⊥_ (Type u) ≅ pempty :=
colimit.iso_colimit_cocone initial_colimit_cocone

/-- The initial object in `Type u` is `pempty`. -/
noncomputable
def is_initial_punit : is_initial (pempty : Type u) :=
initial_is_initial.of_iso initial_iso

open category_theory.limits.walking_pair

/-- The product type `X × Y` forms a cone for the binary product of `X` and `Y`. -/
-- We manually generate the other projection lemmas since the simp-normal form for the legs is
-- otherwise not created correctly.
@[simps X]
def binary_product_cone (X Y : Type u) : binary_fan X Y :=
binary_fan.mk prod.fst prod.snd

@[simp]
lemma binary_product_cone_fst (X Y : Type u) :
  (binary_product_cone X Y).fst = prod.fst :=
rfl
@[simp]
lemma binary_product_cone_snd (X Y : Type u) :
  (binary_product_cone X Y).snd = prod.snd :=
rfl

/-- The product type `X × Y` is a binary product for `X` and `Y`. -/
@[simps]
def binary_product_limit (X Y : Type u) : is_limit (binary_product_cone X Y) :=
{ lift := λ (s : binary_fan X Y) x, (s.fst x, s.snd x),
  fac' := λ s j, discrete.rec_on j (λ j, walking_pair.cases_on j rfl rfl),
  uniq' := λ s m w, funext $ λ x, prod.ext (congr_fun (w ⟨left⟩) x) (congr_fun (w ⟨right⟩) x) }

/--
The category of types has `X × Y`, the usual cartesian product,
as the binary product of `X` and `Y`.
-/
@[simps]
def binary_product_limit_cone (X Y : Type u) : limits.limit_cone (pair X Y) :=
⟨_, binary_product_limit X Y⟩

/-- The categorical binary product in `Type u` is cartesian product. -/
noncomputable def binary_product_iso (X Y : Type u) : limits.prod X Y ≅ X × Y :=
limit.iso_limit_cone (binary_product_limit_cone X Y)

@[simp, elementwise] lemma binary_product_iso_hom_comp_fst (X Y : Type u) :
  (binary_product_iso X Y).hom ≫ prod.fst = limits.prod.fst :=
limit.iso_limit_cone_hom_π (binary_product_limit_cone X Y) ⟨walking_pair.left⟩

@[simp, elementwise] lemma binary_product_iso_hom_comp_snd (X Y : Type u) :
  (binary_product_iso X Y).hom ≫ prod.snd = limits.prod.snd :=
limit.iso_limit_cone_hom_π (binary_product_limit_cone X Y) ⟨walking_pair.right⟩

@[simp, elementwise] lemma binary_product_iso_inv_comp_fst (X Y : Type u) :
  (binary_product_iso X Y).inv ≫ limits.prod.fst = prod.fst :=
limit.iso_limit_cone_inv_π (binary_product_limit_cone X Y) ⟨walking_pair.left⟩

@[simp, elementwise] lemma binary_product_iso_inv_comp_snd (X Y : Type u) :
  (binary_product_iso X Y).inv ≫ limits.prod.snd = prod.snd :=
limit.iso_limit_cone_inv_π (binary_product_limit_cone X Y) ⟨walking_pair.right⟩

/-- The functor which sends `X, Y` to the product type `X × Y`. -/
-- We add the option `type_md` to tell `@[simps]` to not treat homomorphisms `X ⟶ Y` in `Type*` as
-- a function type
@[simps {type_md := reducible}]
def binary_product_functor : Type u ⥤ Type u ⥤ Type u :=
{ obj := λ X,
  { obj := λ Y, X × Y,
    map := λ Y₁ Y₂ f, (binary_product_limit X Y₂).lift (binary_fan.mk prod.fst (prod.snd ≫ f)) },
  map := λ X₁ X₂ f,
  { app := λ Y, (binary_product_limit X₂ Y).lift (binary_fan.mk (prod.fst ≫ f) prod.snd) } }

/--
The product functor given by the instance `has_binary_products (Type u)` is isomorphic to the
explicit binary product functor given by the product type.
-/
noncomputable def binary_product_iso_prod : binary_product_functor ≅ (prod.functor : Type u ⥤ _) :=
begin
  apply nat_iso.of_components (λ X, _) _,
  { apply nat_iso.of_components (λ Y, _) _,
    { exact ((limit.is_limit _).cone_point_unique_up_to_iso (binary_product_limit X Y)).symm },
    { intros Y₁ Y₂ f,
      ext1;
      simp } },
  { intros X₁ X₂ g,
    ext : 3;
    simp }
end

/-- The sum type `X ⊕ Y` forms a cocone for the binary coproduct of `X` and `Y`. -/
@[simps]
def binary_coproduct_cocone (X Y : Type u) : cocone (pair X Y) :=
binary_cofan.mk sum.inl sum.inr

/-- The sum type `X ⊕ Y` is a binary coproduct for `X` and `Y`. -/
@[simps]
def binary_coproduct_colimit (X Y : Type u) : is_colimit (binary_coproduct_cocone X Y) :=
{ desc := λ (s : binary_cofan X Y), sum.elim s.inl s.inr,
  fac' := λ s j, discrete.rec_on j (λ j, walking_pair.cases_on j rfl rfl),
  uniq' := λ s m w, funext $ λ x, sum.cases_on x (congr_fun (w ⟨left⟩)) (congr_fun (w ⟨right⟩)) }

/--
The category of types has `X ⊕ Y`,
as the binary coproduct of `X` and `Y`.
-/
def binary_coproduct_colimit_cocone (X Y : Type u) : limits.colimit_cocone (pair X Y) :=
⟨_, binary_coproduct_colimit X Y⟩

/-- The categorical binary coproduct in `Type u` is the sum `X ⊕ Y`. -/
noncomputable def binary_coproduct_iso (X Y : Type u) : limits.coprod X Y ≅ X ⊕ Y :=
colimit.iso_colimit_cocone (binary_coproduct_colimit_cocone X Y)

open_locale category_theory.Type

@[simp, elementwise] lemma binary_coproduct_iso_inl_comp_hom (X Y : Type u) :
  limits.coprod.inl ≫ (binary_coproduct_iso X Y).hom = sum.inl :=
colimit.iso_colimit_cocone_ι_hom (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.left⟩

@[simp, elementwise] lemma binary_coproduct_iso_inr_comp_hom (X Y : Type u) :
  limits.coprod.inr ≫ (binary_coproduct_iso X Y).hom = sum.inr :=
colimit.iso_colimit_cocone_ι_hom (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.right⟩

@[simp, elementwise] lemma binary_coproduct_iso_inl_comp_inv (X Y : Type u) :
  ↾(sum.inl : X ⟶ X ⊕ Y) ≫ (binary_coproduct_iso X Y).inv = limits.coprod.inl :=
colimit.iso_colimit_cocone_ι_inv (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.left⟩

@[simp, elementwise] lemma binary_coproduct_iso_inr_comp_inv (X Y : Type u) :
  ↾(sum.inr : Y ⟶ X ⊕ Y) ≫ (binary_coproduct_iso X Y).inv = limits.coprod.inr :=
colimit.iso_colimit_cocone_ι_inv (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.right⟩

open function (injective)

lemma binary_cofan_is_colimit_iff {X Y : Type u} (c : binary_cofan X Y) :
  nonempty (is_colimit c) ↔
    injective c.inl ∧ injective c.inr ∧ is_compl (set.range c.inl) (set.range c.inr) :=
begin
  classical,
  split,
  { rintro ⟨h⟩,
    rw [← show _ = c.inl, from h.comp_cocone_point_unique_up_to_iso_inv
      (binary_coproduct_colimit X Y) ⟨walking_pair.left⟩,
      ← show _ = c.inr, from h.comp_cocone_point_unique_up_to_iso_inv
      (binary_coproduct_colimit X Y) ⟨walking_pair.right⟩],
    dsimp [binary_coproduct_cocone],
    refine
    ⟨(h.cocone_point_unique_up_to_iso (binary_coproduct_colimit X Y)).symm.to_equiv.injective.comp
      sum.inl_injective, (h.cocone_point_unique_up_to_iso (binary_coproduct_colimit X Y)).symm
      .to_equiv.injective.comp sum.inr_injective, _⟩,
    erw [set.range_comp, ← eq_compl_iff_is_compl, set.range_comp _ sum.inr, ← set.image_compl_eq
      (h.cocone_point_unique_up_to_iso (binary_coproduct_colimit X Y)).symm.to_equiv.bijective],
    congr' 1,
    exact set.compl_range_inr.symm },
  { rintros ⟨h₁, h₂, h₃⟩,
    have : ∀ x, x ∈ set.range c.inl ∨ x ∈ set.range c.inr,
    { rw [eq_compl_iff_is_compl.mpr h₃.symm], exact λ _, or_not },
    refine ⟨binary_cofan.is_colimit.mk _ _ _ _ _⟩,
    { intros T f g x,
      exact if h : x ∈ set.range c.inl
        then f ((equiv.of_injective _ h₁).symm ⟨x, h⟩)
        else g ((equiv.of_injective _ h₂).symm ⟨x, (this x).resolve_left h⟩) },
    { intros T f g, ext x, dsimp, simp [h₁.eq_iff] },
    { intros T f g, ext x, dsimp,
      simp only [forall_exists_index, equiv.of_injective_symm_apply,
        dif_ctx_congr, dite_eq_right_iff],
      intros y e,
      have : c.inr x ∈ set.range c.inl ⊓ set.range c.inr := ⟨⟨_, e⟩, ⟨_, rfl⟩⟩,
      rw disjoint_iff.mp h₃.1 at this,
      exact this.elim },
    { rintro T _ _ m rfl rfl, ext x, dsimp,
      split_ifs; exact congr_arg _ (equiv.apply_of_injective_symm _ ⟨_, _⟩).symm } }
end

/-- Any monomorphism in `Type` is an coproduct injection. -/
noncomputable
def is_coprod_of_mono {X Y : Type u} (f : X ⟶ Y) [mono f] :
  is_colimit (binary_cofan.mk f (subtype.val : (set.range f)ᶜ → Y)) :=
nonempty.some $ (binary_cofan_is_colimit_iff _).mpr
  ⟨(mono_iff_injective f).mp infer_instance, subtype.val_injective,
    (eq_compl_iff_is_compl.mp $ subtype.range_val).symm⟩

/--
The category of types has `Π j, f j` as the product of a type family `f : J → Type`.
-/
def product_limit_cone {J : Type u} (F : J → Type (max u v)) :
  limits.limit_cone (discrete.functor F) :=
{ cone :=
  { X := Π j, F j,
    π := { app := λ j f, f j.as }, },
  is_limit :=
  { lift := λ s x j, s.π.app ⟨j⟩ x,
    uniq' := λ s m w, funext $ λ x, funext $ λ j, (congr_fun (w ⟨j⟩) x : _) } }

/-- The categorical product in `Type u` is the type theoretic product `Π j, F j`. -/
noncomputable def product_iso {J : Type u} (F : J → Type (max u v)) : ∏ F ≅ Π j, F j :=
limit.iso_limit_cone (product_limit_cone F)

@[simp, elementwise] lemma product_iso_hom_comp_eval {J : Type u} (F : J → Type (max u v)) (j : J) :
  (product_iso F).hom ≫ (λ f, f j) = pi.π F j :=
rfl

@[simp, elementwise] lemma product_iso_inv_comp_π {J : Type u} (F : J → Type (max u v)) (j : J) :
  (product_iso F).inv ≫ pi.π F j = (λ f, f j) :=
limit.iso_limit_cone_inv_π (product_limit_cone F) ⟨j⟩

/--
The category of types has `Σ j, f j` as the coproduct of a type family `f : J → Type`.
-/
def coproduct_colimit_cocone {J : Type u} (F : J → Type u) :
  limits.colimit_cocone (discrete.functor F) :=
{ cocone :=
  { X := Σ j, F j,
    ι :=
    { app := λ j x, ⟨j.as, x⟩ }, },
  is_colimit :=
  { desc := λ s x, s.ι.app ⟨x.1⟩ x.2,
    uniq' := λ s m w,
    begin
      ext ⟨j, x⟩,
      have := congr_fun (w ⟨j⟩) x,
      exact this,
    end }, }

/-- The categorical coproduct in `Type u` is the type theoretic coproduct `Σ j, F j`. -/
noncomputable def coproduct_iso {J : Type u} (F : J → Type u) : ∐ F ≅ Σ j, F j :=
colimit.iso_colimit_cocone (coproduct_colimit_cocone F)

@[simp, elementwise] lemma coproduct_iso_ι_comp_hom {J : Type u} (F : J → Type u) (j : J) :
  sigma.ι F j ≫ (coproduct_iso F).hom = (λ x : F j, (⟨j, x⟩ : Σ j, F j)) :=
colimit.iso_colimit_cocone_ι_hom (coproduct_colimit_cocone F) ⟨j⟩

@[simp, elementwise]

section fork
variables {X Y Z : Type u} (f : X ⟶ Y) {g h : Y ⟶ Z} (w : f ≫ g = f ≫ h)

/--
Show the given fork in `Type u` is an equalizer given that any element in the "difference kernel"
comes from `X`.
The converse of `unique_of_type_equalizer`.
-/
noncomputable def type_equalizer_of_unique (t : ∀ (y : Y), g y = h y → ∃! (x : X), f x = y) :
  is_limit (fork.of_ι _ w) :=
fork.is_limit.mk' _ $ λ s,
begin
  refine ⟨λ i, _, _, _⟩,
  { apply classical.some (t (s.ι i) _),
    apply congr_fun s.condition i },
  { ext i,
    apply (classical.some_spec (t (s.ι i) _)).1 },
  { intros m hm,
    ext i,
    apply (classical.some_spec (t (s.ι i) _)).2,
    apply congr_fun hm i },
end

/-- The converse of `type_equalizer_of_unique`. -/
lemma unique_of_type_equalizer (t : is_limit (fork.of_ι _ w)) (y : Y) (hy : g y = h y) :
  ∃! (x : X), f x = y :=
begin
  let y' : punit ⟶ Y := λ _, y,
  have hy' : y' ≫ g = y' ≫ h := funext (λ _, hy),
  refine ⟨(fork.is_limit.lift' t _ hy').1 ⟨⟩, congr_fun (fork.is_limit.lift' t y' _).2 ⟨⟩, _⟩,
  intros x' hx',
  suffices : (λ (_ : punit), x') = (fork.is_limit.lift' t y' hy').1,
    rw ← this,
  apply fork.is_limit.hom_ext t,
  ext ⟨⟩,
  apply hx'.trans (congr_fun (fork.is_limit.lift' t _ hy').2 ⟨⟩).symm,
end

lemma type_equalizer_iff_unique :
  nonempty (is_limit (fork.of_ι _ w)) ↔ (∀ (y : Y), g y = h y → ∃! (x : X), f x = y) :=
⟨λ i, unique_of_type_equalizer _ _ (classical.choice i), λ k, ⟨type_equalizer_of_unique f w k⟩⟩

/-- Show that the subtype `{x : Y // g x = h x}` is an equalizer for the pair `(g,h)`. -/
def equalizer_limit : limits.limit_cone (parallel_pair g h) :=
{ cone := fork.of_ι (subtype.val : {x : Y // g x = h x} → Y) (funext subtype.prop),
  is_limit := fork.is_limit.mk' _ $ λ s,
    ⟨λ i, ⟨s.ι i, by apply congr_fun s.condition i⟩,
     rfl,
     λ m hm, funext $ λ x, subtype.ext (congr_fun hm x)⟩ }

variables (g h)

/-- The categorical equalizer in `Type u` is `{x : Y // g x = h x}`. -/
noncomputable def equalizer_iso : equalizer g h ≅ {x : Y // g x = h x} :=
limit.iso_limit_cone equalizer_limit

@[simp, elementwise] lemma equalizer_iso_hom_comp_subtype :
  (equalizer_iso g h).hom ≫ subtype.val = equalizer.ι g h :=
rfl

@[simp, elementwise] lemma equalizer_iso_inv_comp_ι :
  (equalizer_iso g h).inv ≫ equalizer.ι g h = subtype.val :=
limit.iso_limit_cone_inv_π equalizer_limit walking_parallel_pair.zero

end fork

section cofork
variables {X Y Z : Type u} (f g : X ⟶ Y)

/-- (Implementation) The relation to be quotiented to obtain the coequalizer. -/
inductive coequalizer_rel : Y → Y → Prop
| rel (x : X) : coequalizer_rel (f x) (g x)

/--
Show that the quotient by the relation generated by `f(x) ~ g(x)`
is a coequalizer for the pair `(f, g)`.
-/
def coequalizer_colimit : limits.colimit_cocone (parallel_pair f g) :=
{ cocone := cofork.of_π (quot.mk (coequalizer_rel f g))
    (funext (λ x, quot.sound (coequalizer_rel.rel x))),
  is_colimit := cofork.is_colimit.mk' _ $ λ s,
    ⟨ quot.lift s.π (λ a b (h : coequalizer_rel f g a b),
        by { cases h, exact congr_fun s.condition h_1 }),
      rfl,
      λ m hm, funext $ λ x, quot.induction_on x (congr_fun hm : _) ⟩ }

/-- If `π : Y ⟶ Z` is an equalizer for `(f, g)`, and `U ⊆ Y` such that `f ⁻¹' U = g ⁻¹' U`,
then `π ⁻¹' (π '' U) = U`.
-/
lemma coequalizer_preimage_image_eq_of_preimage_eq (π : Y ⟶ Z)
  (e : f ≫ π = g ≫ π) (h : is_colimit (cofork.of_π π e)) (U : set Y) (H : f ⁻¹' U = g ⁻¹' U) :
    π ⁻¹' (π '' U) = U :=
begin
  have lem : ∀ x y, (coequalizer_rel f g x y) → (x ∈ U ↔ y ∈ U),
  { rintros _ _ ⟨x⟩, change x ∈ f ⁻¹' U ↔ x ∈ g ⁻¹' U, congr' 2 },
  have eqv : _root_.equivalence (λ x y, x ∈ U ↔ y ∈ U) := by tidy,
  ext,
  split,
  { rw ← (show _ = π, from h.comp_cocone_point_unique_up_to_iso_inv
      (coequalizer_colimit f g).2 walking_parallel_pair.one),
    rintro ⟨y, hy, e'⟩,
    dsimp at e',
    replace e' := (mono_iff_injective (h.cocone_point_unique_up_to_iso
      (coequalizer_colimit f g).is_colimit).inv).mp infer_instance e',
    exact (eqv.eqv_gen_iff.mp (eqv_gen.mono lem (quot.exact _ e'))).mp hy },
  { exact λ hx, ⟨x, hx, rfl⟩ }
end

/-- The categorical coequalizer in `Type u` is the quotient by `f g ~ g x`. -/
noncomputable def coequalizer_iso : coequalizer f g ≅ _root_.quot (coequalizer_rel f g) :=
colimit.iso_colimit_cocone (coequalizer_colimit f g)

@[simp, elementwise] lemma coequalizer_iso_π_comp_hom :
  coequalizer.π f g ≫ (coequalizer_iso f g).hom = quot.mk (coequalizer_rel f g) :=
colimit.iso_colimit_cocone_ι_hom (coequalizer_colimit f g) walking_parallel_pair.one

@[simp, elementwise] lemma coequalizer_iso_quot_comp_inv :
  ↾(quot.mk (coequalizer_rel f g)) ≫ (coequalizer_iso f g).inv = coequalizer.π f g :=
rfl

end cofork

section pullback
open category_theory.limits.walking_pair
open category_theory.limits.walking_cospan
open category_theory.limits.walking_cospan.hom

variables {W X Y Z : Type u}
variables (f : X ⟶ Z) (g : Y ⟶ Z)

/--
The usual explicit pullback in the category of types, as a subtype of the product.
The full `limit_cone` data is bundled as `pullback_limit_cone f g`.
-/
@[nolint has_nonempty_instance]
abbreviation pullback_obj : Type u := { p : X × Y // f p.1 = g p.2 }

-- `pullback_obj f g` comes with a coercion to the product type `X × Y`.
example (p : pullback_obj f g) : X × Y := p

/--
The explicit pullback cone on `pullback_obj f g`.
This is bundled with the `is_limit` data as `pullback_limit_cone f g`.
-/
abbreviation pullback_cone : limits.pullback_cone f g :=
pullback_cone.mk (λ p : pullback_obj f g, p.1.1) (λ p, p.1.2) (funext (λ p, p.2))

/--
The explicit pullback in the category of types, bundled up as a `limit_cone`
for given `f` and `g`.
-/
@[simps]
def pullback_limit_cone (f : X ⟶ Z) (g : Y ⟶ Z) : limits.limit_cone (cospan f g) :=
{ cone := pullback_cone f g,
  is_limit := pullback_cone.is_limit_aux _
    (λ s x, ⟨⟨s.fst x, s.snd x⟩, congr_fun s.condition x⟩)
    (by tidy)
    (by tidy)
    (λ s m w, funext $ λ x, subtype.ext $
     prod.ext (congr_fun (w walking_cospan.left) x)
              (congr_fun (w walking_cospan.right) x)) }

/--
The pullback cone given by the instance `has_pullbacks (Type u)` is isomorphic to the
explicit pullback cone given by `pullback_limit_cone`.
-/
noncomputable def pullback_cone_iso_pullback : limit.cone (cospan f g) ≅ pullback_cone f g :=
(limit.is_limit _).unique_up_to_iso (pullback_limit_cone f g).is_limit

/--
The pullback given by the instance `has_pullbacks (Type u)` is isomorphic to the
explicit pullback object given by `pullback_limit_obj`.
-/
noncomputable def pullback_iso_pullback : pullback f g ≅ pullback_obj f g :=
(cones.forget _).map_iso $ pullback_cone_iso_pullback f g

@[simp] lemma pullback_iso_pullback_hom_fst (p : pullback f g) :
  ((pullback_iso_pullback f g).hom p : X × Y).fst = (pullback.fst : _ ⟶ X) p :=
congr_fun ((pullback_cone_iso_pullback f g).hom.w left) p

@[simp] lemma pullback_iso_pullback_hom_snd (p : pullback f g) :
  ((pullback_iso_pullback f g).hom p : X × Y).snd = (pullback.snd : _ ⟶ Y) p :=
congr_fun ((pullback_cone_iso_pullback f g).hom.w right) p

@[simp] lemma pullback_iso_pullback_inv_fst :
  (pullback_iso_pullback f g).inv ≫ pullback.fst = (λ p, (p : X × Y).fst) :=
(pullback_cone_iso_pullback f g).inv.w left

@[simp] lemma pullback_iso_pullback_inv_snd :
  (pullback_iso_pullback f g).inv ≫ pullback.snd = (λ p, (p : X × Y).snd) :=
(pullback_cone_iso_pullback f g).inv.w right

end pullback

end category_theory.limits.types


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module data.int.cast.field
! leanprover-community/mathlib commit acee671f47b8e7972a1eb6f4eed74b4b3abce829
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Cast.Lemmas
import Mathbin.Algebra.Field.Defs
import Mathbin.Algebra.GroupWithZero.Units.Lemmas

/-!
# Cast of integers into fields

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file concerns the canonical homomorphism `ℤ → F`, where `F` is a field.

## Main results

 * `int.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n`
-/

namespace Int

open Nat

variable {α : Type _}

/- warning: int.cast_neg_nat_cast -> Int.cast_neg_natCast is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : DivisionRing.{u1} R] (n : Nat), Eq.{succ u1} R ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int R (HasLiftT.mk.{1, succ u1} Int R (CoeTCₓ.coe.{1, succ u1} Int R (Int.castCoe.{u1} R (AddGroupWithOne.toHasIntCast.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (DivisionRing.toRing.{u1} R _inst_1))))))) (Neg.neg.{0} Int Int.hasNeg ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) n))) (Neg.neg.{u1} R (SubNegMonoid.toHasNeg.{u1} R (AddGroup.toSubNegMonoid.{u1} R (AddGroupWithOne.toAddGroup.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (DivisionRing.toRing.{u1} R _inst_1)))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat R (HasLiftT.mk.{1, succ u1} Nat R (CoeTCₓ.coe.{1, succ u1} Nat R (Nat.castCoe.{u1} R (AddMonoidWithOne.toNatCast.{u1} R (AddGroupWithOne.toAddMonoidWithOne.{u1} R (AddCommGroupWithOne.toAddGroupWithOne.{u1} R (Ring.toAddCommGroupWithOne.{u1} R (DivisionRing.toRing.{u1} R _inst_1)))))))) n))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : DivisionRing.{u1} R] (n : Nat), Eq.{succ u1} R (Int.cast.{u1} R (Ring.toIntCast.{u1} R (DivisionRing.toRing.{u1} R _inst_1)) (Neg.neg.{0} Int Int.instNegInt (Nat.cast.{0} Int instNatCastInt n))) (Neg.neg.{u1} R (Ring.toNeg.{u1} R (DivisionRing.toRing.{u1} R _inst_1)) (Nat.cast.{u1} R (NonAssocRing.toNatCast.{u1} R (Ring.toNonAssocRing.{u1} R (DivisionRing.toRing.{u1} R _inst_1))) n))
Case conversion may be inaccurate. Consider using '#align int.cast_neg_nat_cast Int.cast_neg_natCastₓ'. -/
/-- Auxiliary lemma for norm_cast to move the cast `-↑n` upwards to `↑-↑n`.

(The restriction to `division_ring` is necessary, otherwise this would also apply in the case where
`R = ℤ` and cause nontermination.)
-/
@[norm_cast]
theorem cast_neg_natCast {R} [DivisionRing R] (n : ℕ) : ((-n : ℤ) : R) = -n := by simp
#align int.cast_neg_nat_cast Int.cast_neg_natCast

/- warning: int.cast_div -> Int.cast_div is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] {m : Int} {n : Int}, (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) n m) -> (Ne.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α (AddGroupWithOne.toHasIntCast.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))))) n) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α (DivisionRing.toRing.{u1} α _inst_1)))))))))) -> (Eq.{succ u1} α ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α (AddGroupWithOne.toHasIntCast.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))))) (HDiv.hDiv.{0, 0, 0} Int Int Int (instHDiv.{0} Int Int.hasDiv) m n)) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivInvMonoid.toHasDiv.{u1} α (DivisionRing.toDivInvMonoid.{u1} α _inst_1))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α (AddGroupWithOne.toHasIntCast.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))))) m) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Int α (HasLiftT.mk.{1, succ u1} Int α (CoeTCₓ.coe.{1, succ u1} Int α (Int.castCoe.{u1} α (AddGroupWithOne.toHasIntCast.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α (DivisionRing.toRing.{u1} α _inst_1))))))) n)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionRing.{u1} α] {m : Int} {n : Int}, (Dvd.dvd.{0} Int Int.instDvdInt n m) -> (Ne.{succ u1} α (Int.cast.{u1} α (Ring.toIntCast.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) n) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (DivisionSemiring.toSemiring.{u1} α (DivisionRing.toDivisionSemiring.{u1} α _inst_1))))))) -> (Eq.{succ u1} α (Int.cast.{u1} α (Ring.toIntCast.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) (HDiv.hDiv.{0, 0, 0} Int Int Int (instHDiv.{0} Int Int.instDivInt_1) m n)) (HDiv.hDiv.{u1, u1, u1} α α α (instHDiv.{u1} α (DivisionRing.toDiv.{u1} α _inst_1)) (Int.cast.{u1} α (Ring.toIntCast.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) m) (Int.cast.{u1} α (Ring.toIntCast.{u1} α (DivisionRing.toRing.{u1} α _inst_1)) n)))
Case conversion may be inaccurate. Consider using '#align int.cast_div Int.cast_divₓ'. -/
@[simp]
theorem cast_div [DivisionRing α] {m n : ℤ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) :
    ((m / n : ℤ) : α) = m / n := by
  rcases n_dvd with ⟨k, rfl⟩
  have : n ≠ 0 := by
    rintro rfl
    simpa using n_nonzero
  rw [Int.mul_ediv_cancel_left _ this, mul_comm n k, Int.cast_mul, mul_div_cancel _ n_nonzero]
#align int.cast_div Int.cast_div

end Int


import data.real.cardinality group_theory.quotient_group

instance rat_cast_is_add_group_hom : is_add_group_hom (coe : ℚ → ℝ) :=
{ to_is_add_hom := { map_add := by simp } }

noncomputable lemma real_equiv_real_mod_rat : ℝ ≃ quotient_add_group.quotient
  (set.range (coe : ℚ → ℝ)) :=
calc ℝ ≃ quotient_add_group.quotient (set.range (coe : ℚ → ℝ)) ×
  (set.range (coe : ℚ → ℝ)) : is_add_subgroup.add_group_equiv_quotient_times_subgroup _
... ≃ _ : quotient_add_group.quotient (set.range (coe : ℚ → ℝ))
#exit