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

Prove provenance for intersection

Browse Source 
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
Danila Fedorin 2023-08-05 00:36:41 -07:00
parent 1780cdbda4
commit 12e76527cc
1 changed files with 54 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
Map.agda
View File

@ -303,6 +303,13 @@ private module ImplInsert (f : B → B → B) where
... | yes _ = refl
... | no _ rewrite update-keys {k} {v} {xs} = refl
updates-keys : ∀ {l₁ l₂ : List (A × B)} →
keys l₂ ≡ keys (updates l₁ l₂)
updates-keys {[]} = refl
updates-keys {(k , v) ∷ xs} {l₂}
rewrite updates-keys {xs} {l₂}
rewrite update-keys {k} {v} {updates xs l₂} = refl
update-preserves-Unique : ∀ {k : A} {v : B} {l : List (A × B)} →
Unique (keys l) → Unique (keys (update k v l ))
update-preserves-Unique {k} {v} {l} u rewrite update-keys {k} {v} {l} = u
@ -332,6 +339,11 @@ private module ImplInsert (f : B → B → B) where
Unique (keys l₂) → Unique (keys (intersect l₁ l₂))
intersect-preserves-Unique {l₁} u = restrict-preserves-Unique (updates-preserve-Unique {l₁} u)
updates-preserve-∉₂ : ∀ {k : A} {l₁ l₂ : List (A × B)} →
¬ k ∈k l₂ → ¬ k ∈k updates l₁ l₂
updates-preserve-∉₂ {k} {l₁} {l₂} k∉kl₁ k∈kl₁l₂
rewrite updates-keys {l₁} {l₂} = k∉kl₁ k∈kl₁l₂
restrict-needs-both : ∀ {k : A} {l₁ l₂ : List (A × B)} →
k ∈k restrict l₁ l₂ → (k ∈k l₁ × k ∈k l₂)
restrict-needs-both {k} {l₁} {[]} ()
@ -347,6 +359,36 @@ private module ImplInsert (f : B → B → B) where
let (k∈kl₁ , k∈kxs) = restrict-needs-both k∈l₁xs
in (k∈kl₁ , there k∈kxs)
restrict-preserves-∉₁ : ∀ {k : A} {l₁ l₂ : List (A × B)} →
¬ k ∈k l₁ → ¬ k ∈k restrict l₁ l₂
restrict-preserves-∉₁ {k} {l₁} {l₂} k∉kl₁ k∈kl₁l₂ =
let (k∈kl₁ , _) = restrict-needs-both {l₂ = l₂} k∈kl₁l₂ in k∉kl₁ k∈kl₁
restrict-preserves-∉₂ : ∀ {k : A} {l₁ l₂ : List (A × B)} →
¬ k ∈k l₂ → ¬ k ∈k restrict l₁ l₂
restrict-preserves-∉₂ {k} {l₁} {l₂} k∉kl₂ k∈kl₁l₂ =
let (_ , k∈kl₂) = restrict-needs-both {l₂ = l₂} k∈kl₁l₂ in k∉kl₂ k∈kl₂
intersect-preserves-∉₁ : ∀ {k : A} {l₁ l₂ : List (A × B)} →
¬ k ∈k l₁ → ¬ k ∈k intersect l₁ l₂
intersect-preserves-∉₁ {k} {l₁} {l₂} = restrict-preserves-∉₁ {k} {l₁} {updates l₁ l₂}
intersect-preserves-∉₂ : ∀ {k : A} {l₁ l₂ : List (A × B)} →
¬ k ∈k l₂ → ¬ k ∈k intersect l₁ l₂
intersect-preserves-∉₂ {k} {l₁} {l₂} k∉l₂ = restrict-preserves-∉₂ (updates-preserve-∉₂ {l₁ = l₁} k∉l₂ )
restrict-preserves-∈₂ : ∀ {k : A} {v : B} {l₁ l₂ : List (A × B)} →
k ∈k l₁ → (k , v) ∈ l₂ → (k , v) ∈ restrict l₁ l₂
restrict-preserves-∈₂ {k} {v} {l₁} {(k' , v') ∷ xs} k∈kl₁ (here k,v≡k',v')
rewrite cong proj₁ k,v≡k',v' rewrite cong proj₂ k,v≡k',v'
with ∈k-dec k' l₁
... | yes _ = here refl
... | no k'∉kl₁ = absurd (k'∉kl₁ k∈kl₁)
restrict-preserves-∈₂ {l₁ = l₁} {l₂ = (k' , v') ∷ xs} k∈kl₁ (there k,v∈xs)
with ∈k-dec k' l₁
... | yes _ = there (restrict-preserves-∈₂ k∈kl₁ k,v∈xs)
... | no _ = restrict-preserves-∈₂ k∈kl₁ k,v∈xs
update-preserves-∈ : ∀ {k k' : A} {v v' : B} {l : List (A × B)} →
¬ k ≡ k' → (k , v) ∈ l → (k , v) ∈ update k' v' l
update-preserves-∈ {k} {k'} {v} {v'} {(k'' , v'') ∷ xs} k≢k' (here k,v≡k'',v'')
@ -433,6 +475,10 @@ module _ (fUnion : B → B → B) (fIntersect : B → B → B) where
open ImplInsert fIntersect using
( restrict-needs-both
; updates
; updates-combine
; intersect-preserves-∉₁
; intersect-preserves-∉₂
; restrict-preserves-∈₂
)
⟦_⟧ : Expr -> Map
@ -445,6 +491,7 @@ module _ (fUnion : B → B → B) (fIntersect : B → B → B) where
in₁ : ∀ {v : B} {e₁ e₂ : Expr} → Provenance k v e₁ → ¬ k ∈k ⟦ e₂ ⟧ → Provenance k v (e₁ ∪ e₂)
in₂ : ∀ {v : B} {e₁ e₂ : Expr} → ¬ k ∈k ⟦ e₁ ⟧ → Provenance k v e₂ → Provenance k v (e₁ ∪ e₂)
bothᵘ : ∀ {v₁ v₂ : B} {e₁ e₂ : Expr} → Provenance k v₁ e₁ → Provenance k v₂ e₂ → Provenance k (fUnion v₁ v₂) (e₁ ∪ e₂)
bothⁱ : ∀ {v₁ v₂ : B} {e₁ e₂ : Expr} → Provenance k v₁ e₁ → Provenance k v₂ e₂ → Provenance k (fIntersect v₁ v₂) (e₁ ∩ e₂)
Expr-Provenance : ∀ (k : A) (e : Expr) → k ∈k ⟦ e ⟧ → Σ B (λ v → (Provenance k v e × (k , v) ∈ ⟦ e ⟧))
Expr-Provenance k (` m) k∈km = let (v , k,v∈m) = locate k∈km in (v , (single k,v∈m , k,v∈m))
@ -463,10 +510,13 @@ module _ (fUnion : B → B → B) (fIntersect : B → B → B) where
... | no k∉ke₁ | no k∉ke₂ = absurd (union-preserves-∉ k∉ke₁ k∉ke₂ k∈ke₁e₂)
Expr-Provenance k (e₁ ∩ e₂) k∈ke₁e₂
with ∈k-dec k (proj₁ ⟦ e₁ ⟧) | ∈k-dec k (proj₁ ⟦ e₂ ⟧)
... | yes k∈ke₁ | yes k∈ke₂ = {!!}
... | yes k∈ke₁ | no k∉ke₂ = {!!}
... | no k∉ke₁ | yes k∈ke₂ = {!!}
... | no k∉ke₁ | no k∉ke₂ = {!!}
... | yes k∈ke₁ | yes k∈ke₂ =
let (v₁ , (g₁ , k,v₁∈e₁)) = Expr-Provenance k e₁ k∈ke₁
(v₂ , (g₂ , k,v₂∈e₂)) = Expr-Provenance k e₂ k∈ke₂
in (fIntersect v₁ v₂ , (bothⁱ g₁ g₂ , restrict-preserves-∈₂ k∈ke₁ (updates-combine (proj₂ ⟦ e₁ ⟧) (proj₂ ⟦ e₂ ⟧) k,v₁∈e₁ k,v₂∈e₂)))
... | yes k∈ke₁ | no k∉ke₂ = absurd (intersect-preserves-∉₂ {l₁ = proj₁ ⟦ e₁ ⟧} k∉ke₂ k∈ke₁e₂)
... | no k∉ke₁ | yes k∈ke₂ = absurd (intersect-preserves-∉₁ {l₂ = proj₁ ⟦ e₂ ⟧} k∉ke₁ k∈ke₁e₂)
... | no k∉ke₁ | no k∉ke₂ = absurd (intersect-preserves-∉₂ {l₁ = proj₁ ⟦ e₁ ⟧} k∉ke₂ k∈ke₁e₂)
module _ (_≈_ : B → B → Set b) where