1
------------------------------------------------------------------------
2
------------------------------------------------------------------------
4
{-# OPTIONS --universe-polymorphism #-}
6
module Data.Function.Equality where
8
open import Data.Function as Fun using (_on_)
10
open import Relation.Binary
12
------------------------------------------------------------------------
16
record _⟶_ {f₁ f₂ t₁ t₂} (From : Setoid f₁ f₂) (To : Setoid t₁ t₂) :
17
Set (f₁ ⊔ f₂ ⊔ t₁ ⊔ t₂) where
21
_⟨$⟩_ : Carrier From → Carrier To
22
cong : _⟨$⟩_ Preserves _≈_ From ⟶ _≈_ To
26
id : ∀ {a₁ a₂} {A : Setoid a₁ a₂} → A ⟶ A
27
id = record { _⟨$⟩_ = Fun.id; cong = Fun.id }
31
_∘_ : ∀ {a₁ a₂} {A : Setoid a₁ a₂}
32
{b₁ b₂} {B : Setoid b₁ b₂}
33
{c₁ c₂} {C : Setoid c₁ c₂} →
36
{ _⟨$⟩_ = Fun._∘_ (_⟨$⟩_ f) (_⟨$⟩_ g)
37
; cong = Fun._∘_ (cong f) (cong g)
40
const : ∀ {a₁ a₂} {A : Setoid a₁ a₂}
41
{b₁ b₂} {B : Setoid b₁ b₂} →
42
Setoid.Carrier B → A ⟶ B
43
const {B = B} b = record
45
; cong = Fun.const (Setoid.refl B)
48
------------------------------------------------------------------------
52
_↝_ : ∀ {a b c d ℓ₁ ℓ₂}
53
{A : Set a} {B : Set b} {C : Set c} {D : Set d} →
54
(∼₁ : REL A B ℓ₁) (∼₂ : REL C D ℓ₂) → REL (A → C) (B → D) _
55
_∼₁_ ↝ _∼₂_ = λ f g → ∀ {x y} → x ∼₁ y → f x ∼₂ g y
57
↝-isEquivalence : ∀ {a b c ℓ₁ ℓ₂} {A : Set a} {B : Set b} {C : Set c}
58
{∼₁ : Rel A ℓ₁} {∼₂ : Rel B ℓ₂}
60
(∀ f → fun f Preserves ∼₁ ⟶ ∼₂) →
61
IsEquivalence ∼₁ → IsEquivalence ∼₂ →
62
IsEquivalence ((∼₁ ↝ ∼₂) on fun)
63
↝-isEquivalence _ cong eq₁ eq₂ = record
64
{ refl = λ {f} x∼₁y → cong f x∼₁y
65
; sym = λ f∼g x∼y → sym eq₂ (f∼g (sym eq₁ x∼y))
66
; trans = λ f∼g g∼h x∼y → trans eq₂ (f∼g (refl eq₁)) (g∼h x∼y)
67
} where open IsEquivalence
70
≡↝ : ∀ {a b c ℓ} {A : Set a} {B : A → Set b} {C : A → Set c} →
71
(∀ x → REL (B x) (C x) ℓ) →
72
REL ((x : A) → B x) ((x : A) → C x) _
73
≡↝ R = λ f g → ∀ x → R x (f x) (g x)
76
∀ {a b ℓ} {A : Set a} {B : A → Set b} {R : ∀ x → Rel (B x) ℓ} →
77
(∀ x → IsEquivalence (R x)) → IsEquivalence (≡↝ R)
78
≡↝-isEquivalence eq = record
80
; sym = λ f∼g x → sym (f∼g x)
81
; trans = λ f∼g g∼h x → trans (f∼g x) (g∼h x)
82
} where open module Eq {x} = IsEquivalence (eq x)
84
------------------------------------------------------------------------
88
_⇨_ : ∀ {f₁ f₂ t₁ t₂} → Setoid f₁ f₂ → Setoid t₁ t₂ → Setoid _ _
91
; _≈_ = (_≈_ S₁ ↝ _≈_ S₂) on _⟨$⟩_
93
↝-isEquivalence (_⟨$⟩_ {From = S₁} {To = S₂})
94
cong (isEquivalence S₁) (isEquivalence S₂)
95
} where open Setoid; open _⟶_
97
_≡⇨_ : ∀ {a s₁ s₂} (A : Set a) → (A → Setoid s₁ s₂) → Setoid _ _
99
{ Carrier = (x : A) → Carrier (S x)
100
; _≈_ = ≡↝ (λ x → _≈_ (S x))
101
; isEquivalence = ≡↝-isEquivalence (λ x → isEquivalence (S x))