aboutsummaryrefslogtreecommitdiff
path: root/Data/System.agda
diff options
context:
space:
mode:
authorJacques Comeaux <jacquesrcomeaux@protonmail.com>2026-01-01 14:31:42 -0600
committerJacques Comeaux <jacquesrcomeaux@protonmail.com>2026-01-01 14:31:42 -0600
commitf84a8d1bf9525aa9a005c1a31045b7685c6ac059 (patch)
treecfb443dfa8f1084a699ee32be55a6fc1200741e0 /Data/System.agda
parentdb3f4ec746f270cab4142dda8ea3f3c1a25d2dd6 (diff)
Update push, pull, and sys functors
Diffstat (limited to 'Data/System.agda')
-rw-r--r--Data/System.agda92
1 files changed, 45 insertions, 47 deletions
diff --git a/Data/System.agda b/Data/System.agda
index d71c2a8..d12fa12 100644
--- a/Data/System.agda
+++ b/Data/System.agda
@@ -66,53 +66,51 @@ module _ {n : ℕ} where
open System
-private
-
- module _ {n : ℕ} where
-
- open _≤_
-
- ≤-refl : Reflexive (_≤_ {n})
- ⇒S ≤-refl = Id _
- ≗-fₛ (≤-refl {x}) _ _ = S.refl x
- ≗-fₒ ≤-refl _ = ≋.refl
-
- ≡⇒≤ : _≡_ Rel.⇒ _≤_
- ≡⇒≤ ≡.refl = ≤-refl
-
- ≤-trans : Transitive _≤_
- ⇒S (≤-trans a b) = ⇒S b ∙ ⇒S a
- ≗-fₛ (≤-trans {x} {y} {z} a b) i s = let open ≈-Reasoning (S z) in begin
- ⇒S b ⟨$⟩ (⇒S a ⟨$⟩ (fₛ′ x i s)) ≈⟨ cong (⇒S b) (≗-fₛ a i s) ⟩
- ⇒S b ⟨$⟩ (fₛ′ y i (⇒S a ⟨$⟩ s)) ≈⟨ ≗-fₛ b i (⇒S a ⟨$⟩ s) ⟩
- fₛ′ z i (⇒S b ⟨$⟩ (⇒S a ⟨$⟩ s)) ∎
- ≗-fₒ (≤-trans {x} {y} {z} a b) s = let open ≈-Reasoning (Values n) in begin
- fₒ′ x s ≈⟨ ≗-fₒ a s ⟩
- fₒ′ y (⇒S a ⟨$⟩ s) ≈⟨ ≗-fₒ b (⇒S a ⟨$⟩ s) ⟩
- fₒ′ z (⇒S b ⟨$⟩ (⇒S a ⟨$⟩ s)) ∎
-
- variable
- A B C : System n
-
- _≈_ : Rel (A ≤ B) 0ℓ
- _≈_ {A} {B} ≤₁ ≤₂ = ⇒S ≤₁ A⇒B.≈ ⇒S ≤₂
- where
- module A⇒B = Setoid (S A ⇒ₛ S B)
-
- open Rel.IsEquivalence
-
- ≈-isEquiv : Rel.IsEquivalence (_≈_ {A} {B})
- ≈-isEquiv {B = B} .refl = S.refl B
- ≈-isEquiv {B = B} .sym a = S.sym B a
- ≈-isEquiv {B = B} .trans a b = S.trans B a b
-
- ≤-resp-≈ : {f h : B ≤ C} {g i : A ≤ B} → f ≈ h → g ≈ i → ≤-trans g f ≈ ≤-trans i h
- ≤-resp-≈ {_} {C} {_} {f} {h} {g} {i} f≈h g≈i {x} = begin
- ⇒S f ⟨$⟩ (⇒S g ⟨$⟩ x) ≈⟨ f≈h ⟩
- ⇒S h ⟨$⟩ (⇒S g ⟨$⟩ x) ≈⟨ cong (⇒S h) g≈i ⟩
- ⇒S h ⟨$⟩ (⇒S i ⟨$⟩ x) ∎
- where
- open ≈-Reasoning (System.S C)
+module _ {n : ℕ} where
+
+ open _≤_
+
+ ≤-refl : Reflexive (_≤_ {n})
+ ⇒S ≤-refl = Id _
+ ≗-fₛ (≤-refl {x}) _ _ = S.refl x
+ ≗-fₒ ≤-refl _ = ≋.refl
+
+ ≡⇒≤ : _≡_ Rel.⇒ _≤_
+ ≡⇒≤ ≡.refl = ≤-refl
+
+ ≤-trans : Transitive _≤_
+ ⇒S (≤-trans a b) = ⇒S b ∙ ⇒S a
+ ≗-fₛ (≤-trans {x} {y} {z} a b) i s = let open ≈-Reasoning (S z) in begin
+ ⇒S b ⟨$⟩ (⇒S a ⟨$⟩ (fₛ′ x i s)) ≈⟨ cong (⇒S b) (≗-fₛ a i s) ⟩
+ ⇒S b ⟨$⟩ (fₛ′ y i (⇒S a ⟨$⟩ s)) ≈⟨ ≗-fₛ b i (⇒S a ⟨$⟩ s) ⟩
+ fₛ′ z i (⇒S b ⟨$⟩ (⇒S a ⟨$⟩ s)) ∎
+ ≗-fₒ (≤-trans {x} {y} {z} a b) s = let open ≈-Reasoning (Values n) in begin
+ fₒ′ x s ≈⟨ ≗-fₒ a s ⟩
+ fₒ′ y (⇒S a ⟨$⟩ s) ≈⟨ ≗-fₒ b (⇒S a ⟨$⟩ s) ⟩
+ fₒ′ z (⇒S b ⟨$⟩ (⇒S a ⟨$⟩ s)) ∎
+
+ variable
+ A B C : System n
+
+ _≈_ : Rel (A ≤ B) 0ℓ
+ _≈_ {A} {B} ≤₁ ≤₂ = ⇒S ≤₁ A⇒B.≈ ⇒S ≤₂
+ where
+ module A⇒B = Setoid (S A ⇒ₛ S B)
+
+ open Rel.IsEquivalence
+
+ ≈-isEquiv : Rel.IsEquivalence (_≈_ {A} {B})
+ ≈-isEquiv {B = B} .refl = S.refl B
+ ≈-isEquiv {B = B} .sym a = S.sym B a
+ ≈-isEquiv {B = B} .trans a b = S.trans B a b
+
+ ≤-resp-≈ : {f h : B ≤ C} {g i : A ≤ B} → f ≈ h → g ≈ i → ≤-trans g f ≈ ≤-trans i h
+ ≤-resp-≈ {_} {C} {_} {f} {h} {g} {i} f≈h g≈i {x} = begin
+ ⇒S f ⟨$⟩ (⇒S g ⟨$⟩ x) ≈⟨ f≈h ⟩
+ ⇒S h ⟨$⟩ (⇒S g ⟨$⟩ x) ≈⟨ cong (⇒S h) g≈i ⟩
+ ⇒S h ⟨$⟩ (⇒S i ⟨$⟩ x) ∎
+ where
+ open ≈-Reasoning (System.S C)
System-≤ : ℕ → Preorder (suc 0ℓ) (suc 0ℓ) ℓ
System-≤ n = record