diff --git a/Lattice.agda b/Lattice.agda index 65b22fd..8c08f0e 100644 --- a/Lattice.agda +++ b/Lattice.agda @@ -76,7 +76,6 @@ module IsEquivalenceInstances where open import Map A B ≡-dec-A using (Map; lift; subset; insert) open import Data.List using (_∷_; []) -- TODO: re-export these with nicer names from map - open import Data.List.Relation.Unary.Any using (Any; here; there) -- TODO: re-export these with nicer names from map open IsEquivalence eB renaming ( ≈-refl to ≈₂-refl diff --git a/Map.agda b/Map.agda index 496917b..1c88133 100644 --- a/Map.agda +++ b/Map.agda @@ -1,4 +1,4 @@ -open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl) +open import Relation.Binary.PropositionalEquality as Eq using (_≡_; refl; sym; cong) open import Relation.Binary.Definitions using (Decidable) open import Relation.Binary.Core using (Rel) open import Relation.Nullary using (Dec; yes; no) @@ -8,26 +8,25 @@ module Map {a b : Level} (A : Set a) (B : Set b) (≡-dec-A : Decidable (_≡_ {a} {A})) where +open import Relation.Nullary using (¬_) open import Data.Nat using (ℕ) open import Data.String using (String; _++_) open import Data.List using (List; []; _∷_) open import Data.List.Membership.Propositional using () -open import Data.Product 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 Data.Product using (_×_; _,_; Σ; proj₁ ; proj₂) open import Data.Unit using (⊤) open import Data.Empty using (⊥) Map : Set (a ⊔ b) Map = List (A × B) -insert : (B → B → B) → A → B → Map → Map -insert f k v [] = (k , v) ∷ [] -insert f k v (x@(k' , v') ∷ xs) with ≡-dec-A k k' -... | yes _ = (k , f v v') ∷ xs -... | no _ = x ∷ insert f k v xs +record ⊤' : Set (a ⊔ b) where -foldr : ∀ {c} {C : Set c} → (A → B → C → C) -> C -> Map -> C -foldr f b [] = b -foldr f b ((k , v) ∷ xs) = f k v (foldr f b xs) +Unique : List (A × B) → Set (a ⊔ b) +Unique [] = ⊤' +Unique ((k , _) ∷ xs) = All (λ (k' , _) → ¬ k ≡ k') xs × Unique xs _∈_ : (A × B) → Map → Set (a ⊔ b) _∈_ p m = Data.List.Membership.Propositional._∈_ p m @@ -40,3 +39,27 @@ lift _≈_ m₁ m₂ = (m₁ ⊆ m₂) × (m₂ ⊆ m₁) where _⊆_ : Map → Map → Set (a ⊔ b) _⊆_ = subset _≈_ + +foldr : ∀ {c} {C : Set c} → (A → B → C → C) -> C -> Map -> C +foldr f b [] = b +foldr f b ((k , v) ∷ xs) = f k v (foldr f b xs) + +insert : (B → B → B) → A → B → Map → Map +insert f k v [] = (k , v) ∷ [] +insert f k v (x@(k' , v') ∷ xs) with ≡-dec-A k k' +... | yes _ = (k , f v v') ∷ xs +... | no _ = x ∷ insert f k v xs + +merge : (B → B → B) → Map → Map → Map +merge f m₁ m₂ = foldr (insert f) m₂ m₁ + +Map-functional : ∀ (k : A) (v v' : B) (xs : List (A × B)) → Unique ((k , v) ∷ xs) → Data.List.Membership.Propositional._∈_ (k , v') ((k , v) ∷ xs) → v ≡ v' +Map-functional k v v' _ _ (here k,v'≡k,v) = sym (cong proj₂ k,v'≡k,v) +Map-functional k v v' xs (k≢ , _) (there k,v'∈xs) = absurd (unique-not-in xs v' (k≢ , k,v'∈xs)) + where + absurd : ∀ {a} {A : Set a} → ⊥ → A + absurd () + + unique-not-in : ∀ (xs : List (A × B)) (v' : B) → ¬ (All (λ (k' , _) → ¬ k ≡ k') xs × (k , v') ∈ xs) + unique-not-in ((k' , _) ∷ xs) v' (k≢k' ∷ _ , here k',≡x) = k≢k' (cong proj₁ k',≡x) + unique-not-in (_ ∷ xs) v' (_ ∷ rest , there k,v'∈xs) = unique-not-in xs v' (rest , k,v'∈xs)