Compare commits
No commits in common. "48983c55b1fb4e371596feafdcd208f8824222ca" and "164fc3636fc98a54b156d1eaf1dde4ce57ba6930" have entirely different histories.
48983c55b1
...
164fc3636f
|
|
@ -103,15 +103,6 @@ record IsSemilattice {a} (A : Set a)
|
|||
, λ a₂≈a₄ → a₁̷≈a₃ (≈-trans a₁≈a₂ (≈-trans a₂≈a₄ (≈-sym a₃≈a₄)))
|
||||
)
|
||||
|
||||
module _ {a} {A : Set a}
|
||||
{_≈_ : A → A → Set a} {_⊔_ : A → A → A}
|
||||
(lA : IsSemilattice A _≈_ _⊔_) where
|
||||
|
||||
open IsSemilattice lA using (_≼_)
|
||||
|
||||
id-Mono : Monotonic _≼_ _≼_ (λ x → x)
|
||||
id-Mono a₁≼a₂ = a₁≼a₂
|
||||
|
||||
module _ {a b} {A : Set a} {B : Set b}
|
||||
{_≈₁_ : A → A → Set a} {_⊔₁_ : A → A → A}
|
||||
{_≈₂_ : B → B → Set b} {_⊔₂_ : B → B → B}
|
||||
|
|
|
|||
200
Lattice/Map.agda
200
Lattice/Map.agda
|
|
@ -9,7 +9,7 @@ module Lattice.Map {a b : Level} (A : Set a) (B : Set b)
|
|||
(≡-dec-A : Decidable (_≡_ {a} {A}))
|
||||
(lB : IsLattice B _≈₂_ _⊔₂_ _⊓₂_) where
|
||||
|
||||
open import Data.List.Membership.Propositional as MemProp using () renaming (_∈_ to _∈ˡ_)
|
||||
import Data.List.Membership.Propositional as MemProp
|
||||
|
||||
open import Relation.Nullary using (¬_; Dec; yes; no)
|
||||
open import Data.Nat using (ℕ)
|
||||
|
|
@ -27,7 +27,6 @@ open IsLattice lB using () renaming
|
|||
; ⊔-idemp to ⊔₂-idemp; ⊔-comm to ⊔₂-comm; ⊔-assoc to ⊔₂-assoc
|
||||
; ⊓-idemp to ⊓₂-idemp; ⊓-comm to ⊓₂-comm; ⊓-assoc to ⊓₂-assoc
|
||||
; absorb-⊔-⊓ to absorb-⊔₂-⊓₂; absorb-⊓-⊔ to absorb-⊓₂-⊔₂
|
||||
; _≼_ to _≼₂_
|
||||
)
|
||||
|
||||
private module ImplKeys where
|
||||
|
|
@ -56,15 +55,6 @@ private module _ where
|
|||
ListAB-functional {l = _ ∷ xs } (push _ uxs) (there k,v∈xs) (there k,v'∈xs) =
|
||||
ListAB-functional uxs k,v∈xs k,v'∈xs
|
||||
|
||||
k∈-dec : ∀ (k : A) (l : List A) → Dec (k ∈ l)
|
||||
k∈-dec k [] = no (λ ())
|
||||
k∈-dec k (x ∷ xs)
|
||||
with (≡-dec-A k x)
|
||||
... | yes refl = yes (here refl)
|
||||
... | no k≢x with (k∈-dec k xs)
|
||||
... | yes k∈xs = yes (there k∈xs)
|
||||
... | no k∉xs = no (λ { (here k≡x) → k≢x k≡x; (there k∈xs) → k∉xs k∈xs })
|
||||
|
||||
∈k-dec : ∀ (k : A) (l : List (A × B)) → Dec (k ∈ keys l)
|
||||
∈k-dec k [] = no (λ ())
|
||||
∈k-dec k ((k' , v) ∷ xs)
|
||||
|
|
@ -473,6 +463,7 @@ private module ImplInsert (f : B → B → B) where
|
|||
intersect-combines u₁ u₂ k,v₁∈l₁ k,v₂∈l₂ =
|
||||
restrict-preserves-∈₂ (∈-cong proj₁ k,v₁∈l₁) (updates-combine u₁ u₂ k,v₁∈l₁ k,v₂∈l₂)
|
||||
|
||||
|
||||
Map : Set (a ⊔ℓ b)
|
||||
Map = Σ (List (A × B)) (λ l → Unique (ImplKeys.keys l))
|
||||
|
||||
|
|
@ -541,7 +532,6 @@ open ImplInsert _⊔₂_ using
|
|||
; union-preserves-∈₁
|
||||
; union-preserves-∈₂
|
||||
; union-preserves-∉
|
||||
; union-preserves-∈k₁
|
||||
)
|
||||
|
||||
⊔-combines : ∀ {k : A} {v₁ v₂ : B} {m₁ m₂ : Map} → (k , v₁) ∈ m₁ → (k , v₂) ∈ m₂ → (k , v₁ ⊔₂ v₂) ∈ (m₁ ⊔ m₂)
|
||||
|
|
@ -592,11 +582,6 @@ 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₂)
|
||||
|
||||
Expr-Provenance-≡ : ∀ (k : A) (v : B) (e : Expr) → (k , v) ∈ ⟦ e ⟧ → Provenance k v e
|
||||
Expr-Provenance-≡ k v e k,v∈e
|
||||
with (v' , (p , k,v'∈e)) ← Expr-Provenance k e (forget {m = ⟦ e ⟧} k,v∈e)
|
||||
rewrite Map-functional {m = ⟦ e ⟧} k,v∈e k,v'∈e = p
|
||||
|
||||
module _ (≈₂-dec : IsDecidable _≈₂_) where
|
||||
private module _ where
|
||||
data SubsetInfo (m₁ m₂ : Map) : Set (a ⊔ℓ b) where
|
||||
|
|
@ -919,184 +904,3 @@ lattice = record
|
|||
|
||||
⊓-equal-keys : ∀ {m₁ m₂ : Map} → keys m₁ ≡ keys m₂ → keys m₁ ≡ keys (m₁ ⊓ m₂)
|
||||
⊓-equal-keys km₁≡km₂ = intersect-equal-keys km₁≡km₂
|
||||
|
||||
private module _ where
|
||||
open MemProp using (_∈_)
|
||||
|
||||
transform : List (A × B) → List A → (A → B) → List (A × B)
|
||||
transform [] _ _ = []
|
||||
transform ((k , v) ∷ xs) ks f
|
||||
with k∈-dec k ks
|
||||
... | yes _ = (k , f k) ∷ transform xs ks f
|
||||
... | no _ = (k , v) ∷ transform xs ks f
|
||||
|
||||
transform-keys-≡ : ∀ (l : List (A × B)) (ks : List A) (f : A → B) →
|
||||
ImplKeys.keys l ≡ ImplKeys.keys (transform l ks f)
|
||||
transform-keys-≡ [] ks f = refl
|
||||
transform-keys-≡ ((k , v) ∷ xs) ks f
|
||||
with k∈-dec k ks
|
||||
... | yes _ rewrite transform-keys-≡ xs ks f = refl
|
||||
... | no _ rewrite transform-keys-≡ xs ks f = refl
|
||||
|
||||
transform-∉k-forward : ∀ {l : List (A × B)} (ks : List A) (f : A → B) {k : A} →
|
||||
¬ k ∈ˡ ImplKeys.keys l → ¬ k ∈ˡ ImplKeys.keys (transform l ks f)
|
||||
transform-∉k-forward {l} ks f k∉kl rewrite transform-keys-≡ l ks f = k∉kl
|
||||
|
||||
transform-∈k-forward : ∀ {l : List (A × B)} (ks : List A) (f : A → B) {k : A} →
|
||||
k ∈ˡ ImplKeys.keys l → k ∈ˡ ImplKeys.keys (transform l ks f)
|
||||
transform-∈k-forward {l} ks f k∈kl rewrite transform-keys-≡ l ks f = k∈kl
|
||||
|
||||
transform-∈k-backward : ∀ {l : List (A × B)} (ks : List A) (f : A → B) {k : A} →
|
||||
k ∈ˡ ImplKeys.keys (transform l ks f) → k ∈ˡ ImplKeys.keys l
|
||||
transform-∈k-backward {l} ks f k∈kt rewrite transform-keys-≡ l ks f = k∈kt
|
||||
|
||||
transform-k∈ks : ∀ (l : List (A × B)) {ks : List A} (f : A → B) {k : A} →
|
||||
k ∈ˡ ks → k ∈ˡ ImplKeys.keys (transform l ks f) → (k , f k) ∈ˡ transform l ks f
|
||||
transform-k∈ks [] _ _ ()
|
||||
transform-k∈ks ((k' , v) ∷ xs) {ks} f {k} k∈ks k∈kl
|
||||
with k∈-dec k' ks | k∈kl
|
||||
... | yes _ | here refl = here refl
|
||||
... | no k∉ks | here refl = ⊥-elim (k∉ks k∈ks)
|
||||
... | yes _ | there k∈kxs = there (transform-k∈ks xs f k∈ks k∈kxs)
|
||||
... | no _ | there k∈kxs = there (transform-k∈ks xs f k∈ks k∈kxs)
|
||||
|
||||
transform-k∉ks-forward : ∀ {l : List (A × B)} {ks : List A} (f : A → B) {k : A} {v : B} →
|
||||
¬ k ∈ˡ ks → (k , v) ∈ˡ l → (k , v) ∈ˡ transform l ks f
|
||||
transform-k∉ks-forward {[]} _ _ ()
|
||||
transform-k∉ks-forward {(k' , v') ∷ xs} {ks} f {k} {v} k∉ks k,v∈l
|
||||
with k∈-dec k' ks | k,v∈l
|
||||
... | yes k∈ks | here refl = ⊥-elim (k∉ks k∈ks)
|
||||
... | no k∉ks | here refl = here refl
|
||||
... | yes _ | there k,v∈xs = there (transform-k∉ks-forward f k∉ks k,v∈xs)
|
||||
... | no _ | there k,v∈xs = there (transform-k∉ks-forward f k∉ks k,v∈xs)
|
||||
|
||||
transform-k∉ks-backward : ∀ {l : List (A × B)} {ks : List A} (f : A → B) {k : A} {v : B} →
|
||||
¬ k ∈ˡ ks → (k , v) ∈ˡ transform l ks f → (k , v) ∈ˡ l
|
||||
transform-k∉ks-backward {[]} _ _ ()
|
||||
transform-k∉ks-backward {(k' , v') ∷ xs} {ks} f {k} {v} k∉ks k,v∈tl
|
||||
with k∈-dec k' ks | k,v∈tl
|
||||
... | yes k∈ks | here refl = ⊥-elim (k∉ks k∈ks)
|
||||
... | no k∉ks | here refl = here refl
|
||||
... | yes _ | there k,v∈txs = there (transform-k∉ks-backward f k∉ks k,v∈txs)
|
||||
... | no _ | there k,v∈txs = there (transform-k∉ks-backward f k∉ks k,v∈txs)
|
||||
|
||||
_updating_via_ : Map → List A → (A → B) → Map
|
||||
_updating_via_ (kvs , uks) ks f =
|
||||
( transform kvs ks f
|
||||
, subst Unique (transform-keys-≡ kvs ks f) uks
|
||||
)
|
||||
|
||||
updating-via-∉k-forward : ∀ (m : Map) (ks : List A) (f : A → B) {k : A} →
|
||||
¬ k ∈k m → ¬ k ∈k (m updating ks via f)
|
||||
updating-via-∉k-forward m = transform-∉k-forward
|
||||
|
||||
updating-via-∈k-forward : ∀ (m : Map) (ks : List A) (f : A → B) {k : A} →
|
||||
k ∈k m → k ∈k (m updating ks via f)
|
||||
updating-via-∈k-forward m = transform-∈k-forward
|
||||
|
||||
updating-via-∈k-backward : ∀ (m : Map) (ks : List A) (f : A → B) {k : A} →
|
||||
k ∈k (m updating ks via f) → k ∈k m
|
||||
updating-via-∈k-backward m = transform-∈k-backward
|
||||
|
||||
updating-via-k∈ks : ∀ (m : Map) {ks : List A} (f : A → B) {k : A} →
|
||||
k ∈ˡ ks → k ∈k (m updating ks via f) → (k , f k) ∈ (m updating ks via f)
|
||||
updating-via-k∈ks m = transform-k∈ks (proj₁ m)
|
||||
|
||||
updating-via-k∈ks-forward : ∀ (m : Map) {ks : List A} (f : A → B) {k : A} →
|
||||
k ∈ˡ ks → k ∈k m → (k , f k) ∈ (m updating ks via f)
|
||||
updating-via-k∈ks-forward m {ks} f k∈ks k∈km rewrite transform-keys-≡ (proj₁ m) ks f = transform-k∈ks (proj₁ m) f k∈ks k∈km
|
||||
|
||||
updating-via-k∈ks-≡ : ∀ (m : Map) {ks : List A} (f : A → B) {k : A} {v : B} →
|
||||
k ∈ˡ ks → (k , v) ∈ (m updating ks via f)→ v ≡ f k
|
||||
updating-via-k∈ks-≡ m {ks} f k∈ks k,v∈um
|
||||
with updating-via-k∈ks m f k∈ks (forget {m = (m updating ks via f)} k,v∈um)
|
||||
... | k,fk∈um = Map-functional {m = (m updating ks via f)} k,v∈um k,fk∈um
|
||||
|
||||
updating-via-k∉ks-forward : ∀ (m : Map) {ks : List A} (f : A → B) {k : A} {v : B} →
|
||||
¬ k ∈ˡ ks → (k , v) ∈ m → (k , v) ∈ (m updating ks via f)
|
||||
updating-via-k∉ks-forward m = transform-k∉ks-forward
|
||||
|
||||
updating-via-k∉ks-backward : ∀ (m : Map) {ks : List A} (f : A → B) {k : A} {v : B} →
|
||||
¬ k ∈ˡ ks → (k , v) ∈ (m updating ks via f) → (k , v) ∈ m
|
||||
updating-via-k∉ks-backward m = transform-k∉ks-backward
|
||||
|
||||
module _ {l} {L : Set l}
|
||||
{_≈ˡ_ : L → L → Set l} {_⊔ˡ_ : L → L → L} {_⊓ˡ_ : L → L → L}
|
||||
(lL : IsLattice L _≈ˡ_ _⊔ˡ_ _⊓ˡ_) where
|
||||
open IsLattice isLattice using (_≼_)
|
||||
open IsLattice lL using () renaming (_≼_ to _≼ˡ_)
|
||||
|
||||
module _ (f : L → Map) (f-Monotonic : Monotonic _≼ˡ_ _≼_ f)
|
||||
(g : A → L → B) (g-Monotonicʳ : ∀ k → Monotonic _≼ˡ_ _≼₂_ (g k))
|
||||
(ks : List A) where
|
||||
|
||||
updater : L → A → B
|
||||
updater l k = g k l
|
||||
|
||||
f' : L → Map
|
||||
f' l = (f l) updating ks via (updater l)
|
||||
|
||||
f'-Monotonic : Monotonic _≼ˡ_ _≼_ f'
|
||||
f'-Monotonic {l₁} {l₂} l₁≼l₂ = (f'l₁f'l₂⊆f'l₂ , f'l₂⊆f'l₁f'l₂)
|
||||
where
|
||||
fl₁fl₂⊆fl₂ = proj₁ (f-Monotonic l₁≼l₂)
|
||||
fl₂⊆fl₁fl₂ = proj₂ (f-Monotonic l₁≼l₂)
|
||||
|
||||
f'l₁f'l₂⊆f'l₂ : ((f' l₁) ⊔ (f' l₂)) ⊆ f' l₂
|
||||
f'l₁f'l₂⊆f'l₂ k v k,v∈f'l₁f'l₂
|
||||
with Expr-Provenance-≡ k v ((` (f' l₁)) ∪ (` (f' l₂))) k,v∈f'l₁f'l₂
|
||||
... | in₁ (single k,v∈f'l₁) k∉kf'l₂ =
|
||||
let
|
||||
k∈kfl₁ = updating-via-∈k-backward (f l₁) ks (updater l₁) (forget {m = f' l₁} k,v∈f'l₁)
|
||||
k∈kfl₁fl₂ = union-preserves-∈k₁ {l₁ = proj₁ (f l₁)} {l₂ = proj₁ (f l₂)} k∈kfl₁
|
||||
(v' , k,v'∈fl₁l₂) = locate {m = (f l₁ ⊔ f l₂)} k∈kfl₁fl₂
|
||||
(v'' , (v'≈v'' , k,v''∈fl₂)) = fl₁fl₂⊆fl₂ k v' k,v'∈fl₁l₂
|
||||
k∈kf'l₂ = updating-via-∈k-forward (f l₂) ks (updater l₂) (forget {m = f l₂} k,v''∈fl₂)
|
||||
in
|
||||
⊥-elim (k∉kf'l₂ k∈kf'l₂)
|
||||
... | in₂ k∉kf'l₁ (single k,v'∈f'l₂) =
|
||||
(v , (IsLattice.≈-refl lB , k,v'∈f'l₂))
|
||||
... | bothᵘ (single {v₁} k,v₁∈f'l₁) (single {v₂} k,v₂∈f'l₂)
|
||||
with k∈-dec k ks
|
||||
... | yes k∈ks
|
||||
with refl ← updating-via-k∈ks-≡ (f l₁) (updater l₁) k∈ks k,v₁∈f'l₁
|
||||
with refl ← updating-via-k∈ks-≡ (f l₂) (updater l₂) k∈ks k,v₂∈f'l₂ =
|
||||
(updater l₂ k , (g-Monotonicʳ k l₁≼l₂ , k,v₂∈f'l₂))
|
||||
... | no k∉ks =
|
||||
let
|
||||
k,v₁∈fl₁ = updating-via-k∉ks-backward (f l₁) (updater l₁) k∉ks k,v₁∈f'l₁
|
||||
k,v₂∈fl₂ = updating-via-k∉ks-backward (f l₂) (updater l₂) k∉ks k,v₂∈f'l₂
|
||||
k,v₁v₂∈fl₁fl₂ = ⊔-combines {m₁ = f l₁} {m₂ = f l₂} k,v₁∈fl₁ k,v₂∈fl₂
|
||||
(v' , (v'≈v₁v₂ , k,v'∈fl₂)) = fl₁fl₂⊆fl₂ k _ k,v₁v₂∈fl₁fl₂
|
||||
k,v'∈f'l₂ = updating-via-k∉ks-forward (f l₂) (updater l₂) k∉ks k,v'∈fl₂
|
||||
in
|
||||
(v' , (v'≈v₁v₂ , k,v'∈f'l₂))
|
||||
|
||||
f'l₂⊆f'l₁f'l₂ : f' l₂ ⊆ ((f' l₁) ⊔ (f' l₂))
|
||||
f'l₂⊆f'l₁f'l₂ k v k,v∈f'l₂
|
||||
with k∈kfl₂ ← updating-via-∈k-backward (f l₂) ks (updater l₂) (forget {m = f' l₂} k,v∈f'l₂)
|
||||
with (v' , k,v'∈fl₂) ← locate {m = f l₂} k∈kfl₂
|
||||
with (v'' , (v'≈v'' , k,v''∈fl₁fl₂)) ← fl₂⊆fl₁fl₂ k v' k,v'∈fl₂
|
||||
with Expr-Provenance-≡ k v'' ((` (f l₁)) ∪ (` (f l₂))) k,v''∈fl₁fl₂
|
||||
... | in₁ (single k,v''∈fl₁) k∉kfl₂ = ⊥-elim (k∉kfl₂ k∈kfl₂)
|
||||
... | in₂ k∉kfl₁ (single k,v''∈fl₂) =
|
||||
let
|
||||
k∉kf'l₁ = updating-via-∉k-forward (f l₁) ks (updater l₁) k∉kfl₁
|
||||
in
|
||||
(v , (IsLattice.≈-refl lB , union-preserves-∈₂ k∉kf'l₁ k,v∈f'l₂))
|
||||
... | bothᵘ (single {v₁} k,v₁∈fl₁) (single {v₂} k,v₂∈fl₂)
|
||||
with k∈-dec k ks
|
||||
... | yes k∈ks with refl ← updating-via-k∈ks-≡ (f l₂) (updater l₂) k∈ks k,v∈f'l₂ =
|
||||
let
|
||||
k,uv₁∈f'l₁ = updating-via-k∈ks-forward (f l₁) (updater l₁) k∈ks (forget {m = f l₁} k,v₁∈fl₁)
|
||||
k,uv₂∈f'l₂ = updating-via-k∈ks-forward (f l₂) (updater l₂) k∈ks (forget {m = f l₂} k,v₂∈fl₂)
|
||||
k,uv₁uv₂∈f'l₁f'l₂ = ⊔-combines {m₁ = f' l₁} {m₂ = f' l₂} k,uv₁∈f'l₁ k,uv₂∈f'l₂
|
||||
in
|
||||
(updater l₁ k ⊔₂ updater l₂ k , (IsLattice.≈-sym lB (g-Monotonicʳ k l₁≼l₂) , k,uv₁uv₂∈f'l₁f'l₂))
|
||||
... | no k∉ks
|
||||
with k,v₁∈f'l₁ ← updating-via-k∉ks-forward (f l₁) (updater l₁) k∉ks k,v₁∈fl₁
|
||||
with k,v₂∈f'l₂ ← updating-via-k∉ks-forward (f l₂) (updater l₂) k∉ks k,v₂∈fl₂
|
||||
with k,v₁v₂∈f'l₁f'l₂ ← ⊔-combines {m₁ = f' l₁} {m₂ = f' l₂} k,v₁∈f'l₁ k,v₂∈f'l₂
|
||||
with refl ← Map-functional {m = f' l₂} k,v∈f'l₂ k,v₂∈f'l₂
|
||||
with refl ← Map-functional {m = f l₂} k,v'∈fl₂ k,v₂∈fl₂ =
|
||||
(v₁ ⊔₂ v , (v'≈v'' , k,v₁v₂∈f'l₁f'l₂))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user