DanilaFe/agda-spa
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add a lattice instance for Map

Browse Source 
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
Danila Fedorin
2023-08-05 18:33:49 -07:00
parent 7b93654c4f
commit c848f443e0
2 changed files with 45 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
Map.agda
View File

@@ -682,8 +682,8 @@ module _ (_≈_ : B → B → Set b) where
(_⊔₂_ : B → B → B) (_⊓₂_ : B → B → B)
(⊔₂-idemp : ∀ (b : B) → (b ⊔₂ b) ≈ b)
(⊓₂-idemp : ∀ (b : B) → (b ⊓₂ b) ≈ b)
(⊔₂-⊓₂-absorb : ∀ {b₁ b₂ : B} → (b₁ ⊔₂ (b₁ ⊓₂ b₂)) ≈ b₁)
(⊓₂-⊔₂-absorb : ∀ {b₁ b₂ : B} → (b₁ ⊓₂ (b₁ ⊔₂ b₂)) ≈ b₁)
(⊔₂-⊓₂-absorb : ∀ (b₁ b₂ : B) → (b₁ ⊔₂ (b₁ ⊓₂ b₂)) ≈ b₁)
(⊓₂-⊔₂-absorb : ∀ (b₁ b₂ : B) → (b₁ ⊓₂ (b₁ ⊔₂ b₂)) ≈ b₁)
where
private module I⊔ = ImplInsert _⊔₂_
private module I⊓ = ImplInsert _⊓₂_
@@ -703,7 +703,7 @@ module _ (_≈_ : B → B → Set b) where
(single {v₂} v₂∈m₂)) , v₁v₁'v₂∈m₁m₁₂))
rewrite Map-functional {m = m₁} k,v₁∈m₁ k,v₁'∈m₁
rewrite Map-functional {m = m₁ ⊓ (m₁ ⊔ m₂)} k,v∈m₁m₁₂ v₁v₁'v₂∈m₁m₁₂ =
(v₁' , (⊓₂-⊔₂-absorb , k,v₁'∈m₁))
(v₁' , (⊓₂-⊔₂-absorb v₁' v₂ , k,v₁'∈m₁))
... | (_ , (bothⁱ (single {v₁} k,v₁∈m₁)
(in₁ (single {v₁'} k,v₁'∈m₁) _) , v₁v₁'∈m₁m₁₂))
rewrite Map-functional {m = m₁} k,v₁∈m₁ k,v₁'∈m₁
@@ -717,7 +717,7 @@ module _ (_≈_ : B → B → Set b) where
with ∈k-dec k l₂
... | yes k∈km₂ =
let (v₂ , k,v₂∈m₂) = locate k∈km₂
in (v ⊓₂ (v ⊔₂ v₂) , (≈-sym ⊓₂-⊔₂-absorb , I⊓.intersect-combines u₁ (I⊔.union-preserves-Unique l₁ l₂ u₂) k,v∈m₁ (I⊔.union-combines u₁ u₂ k,v∈m₁ k,v₂∈m₂)))
in (v ⊓₂ (v ⊔₂ v₂) , (≈-sym (⊓₂-⊔₂-absorb v v₂) , I⊓.intersect-combines u₁ (I⊔.union-preserves-Unique l₁ l₂ u₂) k,v∈m₁ (I⊔.union-combines u₁ u₂ k,v∈m₁ k,v₂∈m₂)))
... | no k∉km₂ = (v ⊓₂ v , (≈-sym (⊓₂-idemp v) , I⊓.intersect-combines u₁ (I⊔.union-preserves-Unique l₁ l₂ u₂) k,v∈m₁ (I⊔.union-preserves-∈₁ u₁ k,v∈m₁ k∉km₂)))
union-intersect-absorb : ∀ (m₁ m₂ : Map) → lift (m₁ ⊔ (m₁ ⊓ m₂)) m₁
@@ -731,7 +731,7 @@ module _ (_≈_ : B → B → Set b) where
(single {v₂} k,v₂∈m₂)) , v₁v₁'v₂∈m₁m₁₂))
rewrite Map-functional {m = m₁} k,v₁∈m₁ k,v₁'∈m₁
rewrite Map-functional {m = m₁ ⊔ (m₁ ⊓ m₂)} k,v∈m₁m₁₂ v₁v₁'v₂∈m₁m₁₂ =
(v₁' , (⊔₂-⊓₂-absorb , k,v₁'∈m₁))
(v₁' , (⊔₂-⊓₂-absorb v₁' v₂ , k,v₁'∈m₁))
... | (_ , (in₁ (single {v₁} k,v₁∈m₁) k∉km₁₂ , k,v₁∈m₁m₁₂))
rewrite Map-functional {m = m₁ ⊔ (m₁ ⊓ m₂)} k,v∈m₁m₁₂ k,v₁∈m₁m₁₂ =
(v₁ , (≈-refl , k,v₁∈m₁))
@@ -744,5 +744,5 @@ module _ (_≈_ : B → B → Set b) where
with ∈k-dec k l₂
... | yes k∈km₂ =
let (v₂ , k,v₂∈m₂) = locate k∈km₂
in (v ⊔₂ (v ⊓₂ v₂) , (≈-sym ⊔₂-⊓₂-absorb , I⊔.union-combines u₁ (I⊓.intersect-preserves-Unique {l₁} {l₂} u₂) k,v∈m₁ (I⊓.intersect-combines u₁ u₂ k,v∈m₁ k,v₂∈m₂)))
in (v ⊔₂ (v ⊓₂ v₂) , (≈-sym (⊔₂-⊓₂-absorb v v₂) , I⊔.union-combines u₁ (I⊓.intersect-preserves-Unique {l₁} {l₂} u₂) k,v∈m₁ (I⊓.intersect-combines u₁ u₂ k,v∈m₁ k,v₂∈m₂)))
... | no k∉km₂ = (v , (≈-refl , I⊔.union-preserves-∈₁ u₁ k,v∈m₁ (I⊓.intersect-preserves-∉₂ {k} {l₁} {l₂} k∉km₂)))