summaryrefslogtreecommitdiff
path: root/Precond.agda
diff options
context:
space:
mode:
authorHelmut Grohne <grohne@cs.uni-bonn.de>2014-02-04 10:32:34 +0100
committerHelmut Grohne <grohne@cs.uni-bonn.de>2014-02-04 10:32:34 +0100
commit257665f2910296c6e87113d2f7a418e1f83b33f6 (patch)
tree5f179250edf342f351d679f263c22d97d6496811 /Precond.agda
parente227314c11a17efa2e41ee8756041c4e5b747792 (diff)
parent6eff9c9c93e942ac4bf39cd6d62c0ae0d601c1ae (diff)
downloadbidiragda-257665f2910296c6e87113d2f7a418e1f83b33f6.tar.gz
Merge branch feature-get-record into feature-partial-getlen
These two features heavily interconnect. As such it makes sense to integrate them properly. This non-trivial merge does that work. Compared to feature-partial-getlen a few definitions moved from FreeTheorems.agda to GetTypes.agda. Many types changed compared to both branches. Conflicts: BFF.agda Bidir.agda FreeTheorems.agda Precond.agda conflict in GetTypes.agda not detected by merge
Diffstat (limited to 'Precond.agda')
-rw-r--r--Precond.agda14
1 files changed, 8 insertions, 6 deletions
diff --git a/Precond.agda b/Precond.agda
index a6f2871..787f010 100644
--- a/Precond.agda
+++ b/Precond.agda
@@ -34,8 +34,9 @@ import CheckInsert
open CheckInsert (decSetoid deq) using (checkInsert ; lemma-checkInsert-new ; lemma-lookupM-checkInsert-other)
import BFF
open import Bidir (decSetoid deq) using (_in-domain-of_ ; lemma-assoc-domain ; lemma-just-sequence)
-
-open BFF.PartialVecBFF (decSetoid deq) using (get-type ; assoc ; enumerate ; denumerate ; bff)
+import GetTypes
+open GetTypes.PartialVecVec using (Get ; module Get)
+open BFF.PartialVecBFF (decSetoid deq) using (assoc ; enumerate ; denumerate ; bff)
lemma-lookup-map-just : {n : ℕ} (f : Fin n) {A : Set} (v : Vec A n) → lookup f (map Maybe.just v) ≡ Maybe.just (lookup f v)
lemma-lookup-map-just zero (x ∷ xs) = refl
@@ -73,9 +74,9 @@ lemma-union-delete-fromFunc {n = n} {is = i ∷ is} {h = h} {g = g} ((x , px) Da
maybe′ just (lookupM i (delete-many is (map just g))) (lookup i h) ∎
inner f | no f≢i = cong (flip (maybe′ just) (lookup f h)) (lemma-lookupM-delete (delete-many is (map just g)) f≢i)
-assoc-enough : {I : Setoid ℓ₀ ℓ₀} → (gl₁ : I ↪ EqSetoid ℕ) → (gl₂ : I ⟶ EqSetoid ℕ) → (get : get-type gl₁ gl₂) → {i : Setoid.Carrier I} → (s : Vec Carrier (to gl₁ ⟨$⟩ i)) → (v : Vec Carrier (gl₂ ⟨$⟩ i)) → ∃ (λ h → assoc (get (enumerate s)) v ≡ just h) → ∃ λ u → bff gl₁ gl₂ get s v ≡ just u
-assoc-enough gl₁ gl₂ get s v (h , p) = let w , pw = lemma-union-delete-fromFunc (lemma-assoc-domain (get s′) v h p) in _ , (begin
- bff gl₁ gl₂ get s v
+assoc-enough : (G : Get) → {i : Setoid.Carrier (Get.I G)} → (s : Vec Carrier (to (Get.gl₁ G) ⟨$⟩ i)) → (v : Vec Carrier (Get.gl₂ G ⟨$⟩ i)) → ∃ (λ h → assoc (Get.get G (enumerate s)) v ≡ just h) → ∃ λ u → bff G s v ≡ just u
+assoc-enough G s v (h , p) = let w , pw = lemma-union-delete-fromFunc (lemma-assoc-domain (get s′) v h p) in _ , (begin
+ bff G s v
≡⟨ cong (flip _>>=_ (flip mapMV s′ ∘ flip lookupM) ∘ _<$>_ (flip union g′)) p ⟩
mapMV (flip lookupM (union h g′)) s′
≡⟨ sym (sequence-map (flip lookupM (union h g′)) s′) ⟩
@@ -88,7 +89,8 @@ assoc-enough gl₁ gl₂ get s v (h , p) = let w , pw = lemma-union-delete-fromF
sequenceV (map Maybe.just (map (flip lookup w) s′))
≡⟨ lemma-just-sequence (map (flip lookup w) s′) ⟩
just (map (flip lookup w) s′) ∎)
- where s′ = enumerate s
+ where open Get G
+ s′ = enumerate s
g = fromFunc (denumerate s)
g′ = delete-many (get s′) g