Clean up 'Map' to hide implementation details, extract code
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
parent
1b8c88b1a2
commit
d718338759
|
@ -19,6 +19,7 @@ open import Data.List.Relation.Unary.Any using (Any; here; there) -- TODO: re-ex
|
|||
open import Data.Product using (_×_; _,_; Σ; proj₁ ; proj₂)
|
||||
open import Data.Empty using (⊥; ⊥-elim)
|
||||
open import Equivalence
|
||||
open import Utils using (Unique; push; empty; Unique-append; All¬-¬Any)
|
||||
|
||||
open IsLattice lB using () renaming
|
||||
( ≈-refl to ≈₂-refl; ≈-sym to ≈₂-sym; ≈-trans to ≈₂-trans
|
||||
|
@ -28,34 +29,10 @@ open IsLattice lB using () renaming
|
|||
; absorb-⊔-⊓ to absorb-⊔₂-⊓₂; absorb-⊓-⊔ to absorb-⊓₂-⊔₂
|
||||
)
|
||||
|
||||
module ImplKeys where
|
||||
private module ImplKeys where
|
||||
keys : List (A × B) → List A
|
||||
keys = map proj₁
|
||||
|
||||
data Unique {c} {C : Set c} : List C → Set c where
|
||||
empty : Unique []
|
||||
push : ∀ {x : C} {xs : List C}
|
||||
→ All (λ x' → ¬ x ≡ x') xs
|
||||
→ Unique xs
|
||||
→ Unique (x ∷ xs)
|
||||
|
||||
Unique-append : ∀ {c} {C : Set c} {x : C} {xs : List C} →
|
||||
¬ MemProp._∈_ x xs → Unique xs → Unique (xs ++ (x ∷ []))
|
||||
Unique-append {c} {C} {x} {[]} _ _ = push [] empty
|
||||
Unique-append {c} {C} {x} {x' ∷ xs'} x∉xs (push x'≢ uxs') =
|
||||
push (help x'≢) (Unique-append (λ x∈xs' → x∉xs (there x∈xs')) uxs')
|
||||
where
|
||||
x'≢x : ¬ x' ≡ x
|
||||
x'≢x x'≡x = x∉xs (here (sym x'≡x))
|
||||
|
||||
help : {l : List C} → All (λ x'' → ¬ x' ≡ x'') l → All (λ x'' → ¬ x' ≡ x'') (l ++ (x ∷ []))
|
||||
help {[]} _ = x'≢x ∷ []
|
||||
help {e ∷ es} (x'≢e ∷ x'≢es) = x'≢e ∷ help x'≢es
|
||||
|
||||
All¬-¬Any : ∀ {p c} {C : Set c} {P : C → Set p} {l : List C} → All (λ x → ¬ P x) l → ¬ Any P l
|
||||
All¬-¬Any {l = x ∷ xs} (¬Px ∷ _) (here Px) = ¬Px Px
|
||||
All¬-¬Any {l = x ∷ xs} (_ ∷ ¬Pxs) (there Pxs) = All¬-¬Any ¬Pxs Pxs
|
||||
|
||||
private module _ where
|
||||
open MemProp using (_∈_)
|
||||
open ImplKeys
|
||||
|
@ -559,6 +536,8 @@ Expr-Provenance k (e₁ ∩ e₂) k∈ke₁e₂
|
|||
... | no k∉ke₁ | yes k∈ke₂ = ⊥-elim (intersect-preserves-∉₁ {l₂ = proj₁ ⟦ e₂ ⟧} k∉ke₁ k∈ke₁e₂)
|
||||
... | no k∉ke₁ | no k∉ke₂ = ⊥-elim (intersect-preserves-∉₂ {l₁ = proj₁ ⟦ e₁ ⟧} k∉ke₂ k∈ke₁e₂)
|
||||
|
||||
module _ (≈₂-dec : ∀ (b₁ b₂ : B) → Dec (b₁ ≈₂ b₂)) where
|
||||
private module _ where
|
||||
data SubsetInfo (m₁ m₂ : Map) : Set (a ⊔ℓ b) where
|
||||
extra : (k : A) → k ∈k m₁ → ¬ k ∈k m₂ → SubsetInfo m₁ m₂
|
||||
mismatch : (k : A) (v₁ v₂ : B) → (k , v₁) ∈ m₁ → (k , v₂) ∈ m₂ → ¬ v₁ ≈₂ v₂ → SubsetInfo m₁ m₂
|
||||
|
@ -576,7 +555,6 @@ SubsetInfo-to-dec {m₁} {m₂} (mismatch k v₁ v₂ k,v₁∈m₁ k,v₂∈m
|
|||
in v₁̷≈v₂ (subst (λ v'' → v₁ ≈₂ v'') (Map-functional {k} {v'} {v₂} {m₂} k,v'∈m₂ k,v₂∈m₂) v₁≈v')) -- for some reason, can't just use subst...
|
||||
SubsetInfo-to-dec (fine m₁⊆m₂) = yes m₁⊆m₂
|
||||
|
||||
module _ (≈₂-dec : ∀ (b₁ b₂ : B) → Dec (b₁ ≈₂ b₂)) where
|
||||
compute-SubsetInfo : ∀ m₁ m₂ → SubsetInfo m₁ m₂
|
||||
compute-SubsetInfo ([] , _) m₂ = fine (λ k v ())
|
||||
compute-SubsetInfo m₁@((k , v) ∷ xs₁ , push k≢xs₁ uxs₁) m₂@(l₂ , u₂)
|
||||
|
|
32
Utils.agda
Normal file
32
Utils.agda
Normal file
|
@ -0,0 +1,32 @@
|
|||
module Utils where
|
||||
|
||||
open import Data.List using (List; []; _∷_; _++_)
|
||||
open import Data.List.Membership.Propositional using (_∈_)
|
||||
open import Data.List.Relation.Unary.All using (All; []; _∷_)
|
||||
open import Data.List.Relation.Unary.Any using (Any; here; there) -- TODO: re-export these with nicer names from map
|
||||
open import Relation.Binary.PropositionalEquality using (_≡_; sym)
|
||||
open import Relation.Nullary using (¬_)
|
||||
|
||||
data Unique {c} {C : Set c} : List C → Set c where
|
||||
empty : Unique []
|
||||
push : ∀ {x : C} {xs : List C}
|
||||
→ All (λ x' → ¬ x ≡ x') xs
|
||||
→ Unique xs
|
||||
→ Unique (x ∷ xs)
|
||||
|
||||
Unique-append : ∀ {c} {C : Set c} {x : C} {xs : List C} →
|
||||
¬ x ∈ xs → Unique xs → Unique (xs ++ (x ∷ []))
|
||||
Unique-append {c} {C} {x} {[]} _ _ = push [] empty
|
||||
Unique-append {c} {C} {x} {x' ∷ xs'} x∉xs (push x'≢ uxs') =
|
||||
push (help x'≢) (Unique-append (λ x∈xs' → x∉xs (there x∈xs')) uxs')
|
||||
where
|
||||
x'≢x : ¬ x' ≡ x
|
||||
x'≢x x'≡x = x∉xs (here (sym x'≡x))
|
||||
|
||||
help : {l : List C} → All (λ x'' → ¬ x' ≡ x'') l → All (λ x'' → ¬ x' ≡ x'') (l ++ (x ∷ []))
|
||||
help {[]} _ = x'≢x ∷ []
|
||||
help {e ∷ es} (x'≢e ∷ x'≢es) = x'≢e ∷ help x'≢es
|
||||
|
||||
All¬-¬Any : ∀ {p c} {C : Set c} {P : C → Set p} {l : List C} → All (λ x → ¬ P x) l → ¬ Any P l
|
||||
All¬-¬Any {l = x ∷ xs} (¬Px ∷ _) (here Px) = ¬Px Px
|
||||
All¬-¬Any {l = x ∷ xs} (_ ∷ ¬Pxs) (there Pxs) = All¬-¬Any ¬Pxs Pxs
|
Loading…
Reference in New Issue
Block a user