Prove provenance for intersection

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

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