aboutsummaryrefslogtreecommitdiffstats
path: root/maptools.v
diff options
context:
space:
mode:
Diffstat (limited to 'maptools.v')
-rw-r--r--maptools.v476
1 files changed, 476 insertions, 0 deletions
diff --git a/maptools.v b/maptools.v
new file mode 100644
index 0000000..2478430
--- /dev/null
+++ b/maptools.v
@@ -0,0 +1,476 @@
1Require Import Coq.Strings.String.
2From stdpp Require Import countable fin_maps fin_map_dom.
3
4(** Generic lemmas for finite maps and their domains *)
5
6Lemma map_insert_empty_lookup {A} `{FinMap K M}
7 (i j : K) (u v : A) :
8 <[i := u]> (∅ : M A) !! j = Some v → i = j ∧ v = u.
9Proof.
10 intros Hiel.
11 destruct (decide (i = j)).
12 - split; try done. simplify_eq /=.
13 rewrite lookup_insert in Hiel. congruence.
14 - rewrite lookup_insert_ne in Hiel; try done.
15 exfalso. eapply lookup_empty_Some, Hiel.
16Qed.
17
18Lemma map_insert_ne_inv `{FinMap K M} {A}
19 (m1 m2 : M A) i j x y :
20 i ≠ j →
21 <[i := x]>m1 = <[j := y]>m2 →
22 m2 !! i = Some x ∧ m1 !! j = Some y ∧
23 delete i (delete j m1) = delete i (delete j m2).
24Proof.
25 intros Hneq Heq.
26 split; try split.
27 - rewrite <-lookup_delete_ne with (i := j) by congruence.
28 rewrite <-delete_insert_delete with (x := y).
29 rewrite <-Heq.
30 rewrite lookup_delete_ne by congruence.
31 by rewrite lookup_insert.
32 - rewrite <-lookup_delete_ne with (i := i) by congruence.
33 rewrite <-delete_insert_delete with (x := x).
34 rewrite Heq.
35 rewrite lookup_delete_ne by congruence.
36 by rewrite lookup_insert.
37 - setoid_rewrite <-delete_insert_delete with (x := x) at 1.
38 setoid_rewrite <-delete_insert_delete with (x := y) at 4.
39 rewrite <-delete_insert_ne by congruence.
40 by do 2 f_equal.
41Qed.
42
43Lemma map_insert_inv `{FinMap K M} {A}
44 (m1 m2 : M A) i x y :
45 <[i := x]>m1 = <[i := y]>m2 →
46 x = y ∧ delete i m1 = delete i m2.
47Proof.
48 intros Heq.
49 split; try split.
50 - apply Some_inj.
51 replace (Some x) with (<[i := x]>m1 !! i) by apply lookup_insert.
52 replace (Some y) with (<[i := y]>m2 !! i) by apply lookup_insert.
53 by rewrite Heq.
54 - replace (delete i m1) with (delete i (<[i := x]>m1))
55 by apply delete_insert_delete.
56 replace (delete i m2) with (delete i (<[i := y]>m2))
57 by apply delete_insert_delete.
58 by rewrite Heq.
59Qed.
60
61Lemma fmap_insert_lookup `{FinMap K M} {A B}
62 (f : A → B) (m1 : M A) (m2 : M B) i x :
63 f <$> m1 = <[i := x]>m2 →
64 f <$> m1 !! i = Some x.
65Proof.
66 intros Hmap.
67 rewrite <-lookup_fmap.
68 rewrite Hmap.
69 apply lookup_insert.
70Qed.
71
72Lemma map_dom_delete_insert_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
73 (m1 : M A) (m2 : M B) i x y :
74 dom (delete i m1) = dom (delete i m2) →
75 dom (<[i := x]>m1) = dom (<[i := y]> m2).
76Proof.
77 intros Hdel.
78 setoid_rewrite <-insert_delete_insert at 1 2.
79 rewrite 2 dom_insert_L.
80 set_solver.
81Qed.
82
83Lemma map_dom_delete_insert_subseteq_L `{FinMapDom K M D} `{!LeibnizEquiv D}
84 {A B} (m1 : M A) (m2 : M B) i x y :
85 dom (delete i m1) ⊆ dom (delete i m2) →
86 dom (<[i := x]>m1) ⊆ dom (<[i := y]> m2).
87Proof.
88 intros Hdel.
89 setoid_rewrite <-insert_delete_insert at 1 2.
90 rewrite 2 dom_insert_L.
91 set_solver.
92Qed.
93
94Lemma map_dom_empty_eq_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A}
95 (m : M A) : dom (∅ : M A) = dom m → m = ∅.
96Proof.
97 intros Hdom.
98 rewrite dom_empty_L in Hdom.
99 symmetry in Hdom.
100 by apply dom_empty_inv_L.
101Qed.
102
103Lemma map_dom_insert_eq_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A}
104 (i : K) (x : A) (m1 m2 : M A) :
105 dom (<[i := x]>m1) = dom m2 →
106 dom (delete i m1) = dom (delete i m2) ∧ i ∈ dom m2.
107Proof. set_solver. Qed.
108
109(** map_mapM *)
110
111Definition map_mapM {M : Type → Type} `{MBind F} `{MRet F} `{FinMap K M} {A B}
112 (f : A → F B) (m : M A) : F (M B) :=
113 map_fold (λ i x om', m' ← om'; x' ← f x; mret $ <[i := x']>m') (mret ∅) m.
114
115Lemma map_mapM_dom_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
116 (f : A → option B) (m1 : M A) (m2 : M B) :
117 map_mapM f m1 = Some m2 → dom m1 = dom m2.
118Proof.
119 revert m2.
120 induction m1 using map_ind; intros m2 HmapM.
121 - unfold map_mapM in HmapM. rewrite map_fold_empty in HmapM.
122 simplify_option_eq.
123 by rewrite 2 dom_empty_L.
124 - unfold map_mapM in HmapM.
125 rewrite map_fold_insert_L in HmapM.
126 + simplify_option_eq.
127 apply IHm1 in Heqo.
128 rewrite 2 dom_insert_L.
129 by f_equal.
130 + intros.
131 destruct y; simplify_option_eq; try done.
132 destruct (f z2); simplify_option_eq.
133 * destruct (f z1); simplify_option_eq; try done.
134 f_equal. by apply insert_commute.
135 * destruct (f z1); by simplify_option_eq.
136 + done.
137Qed.
138
139Lemma map_mapM_option_insert_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
140 (f : A → option B) (m1 : M A) (m2 m2' : M B)
141 (i : K) (x : A) (x' : B) :
142 m1 !! i = None →
143 map_mapM f (<[i := x]>m1) = Some m2 →
144 ∃ x', f x = Some x' ∧ map_mapM f m1 = Some (delete i m2).
145Proof.
146 intros Helem HmapM.
147 unfold map_mapM in HmapM.
148 rewrite map_fold_insert_L in HmapM.
149 - simplify_option_eq.
150 exists H15.
151 split; try done.
152 rewrite delete_insert.
153 apply Heqo.
154 apply map_mapM_dom_L in Heqo.
155 apply not_elem_of_dom in Helem.
156 apply not_elem_of_dom.
157 set_solver.
158 - intros.
159 destruct y; simplify_option_eq; try done.
160 destruct (f z2); simplify_option_eq.
161 + destruct (f z1); simplify_option_eq; try done.
162 f_equal. by apply insert_commute.
163 + destruct (f z1); by simplify_option_eq.
164 - done.
165Qed.
166
167(** map_Forall2 *)
168
169Definition map_Forall2 `{∀ A, Lookup K A (M A)} {A B}
170 (R : A → B → Prop) :=
171 map_relation (M := M) R (λ _, False) (λ _, False).
172
173Global Instance map_Forall2_dec `{FinMap K M} {A B} (R : A → B → Prop)
174 `{∀ a b, Decision (R a b)} : RelDecision (map_Forall2 (M := M) R).
175Proof. apply map_relation_dec; intros; try done; apply False_dec. Qed.
176
177Lemma map_Forall2_insert_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
178 (m1 : M A) (m2 : M B) R i x y :
179 m1 !! i = None →
180 m2 !! i = None →
181 R x y →
182 map_Forall2 R m1 m2 →
183 map_Forall2 R (<[i := x]>m1) (<[i := y]>m2).
184Proof.
185 unfold map_Forall2, map_relation, option_relation.
186 intros Him1 Him2 HR HForall2 j.
187 destruct (decide (i = j)).
188 + simplify_option_eq. by rewrite 2 lookup_insert.
189 + rewrite 2 lookup_insert_ne by done. apply HForall2.
190Qed.
191
192Lemma map_Forall2_insert_weak `{FinMap K M} {A B}
193 (m1 : M A) (m2 : M B) R i x y :
194 R x y →
195 map_Forall2 R (delete i m1) (delete i m2) →
196 map_Forall2 R (<[i := x]>m1) (<[i := y]>m2).
197Proof.
198 unfold map_Forall2, map_relation, option_relation.
199 intros HR HForall2 j.
200 destruct (decide (i = j)).
201 - simplify_option_eq. by rewrite 2 lookup_insert.
202 - rewrite 2 lookup_insert_ne by done.
203 rewrite <-lookup_delete_ne with (i := i) by done.
204 replace (m2 !! j) with (delete i m2 !! j); try by apply lookup_delete_ne.
205 apply HForall2.
206Qed.
207
208Lemma map_Forall2_destruct `{FinMap K M} {A B}
209 (m1 : M A) (m2 : M B) R i x :
210 map_Forall2 R (<[i := x]>m1) m2 →
211 ∃ y m2', m2' !! i = None ∧ m2 = <[i := y]>m2'.
212Proof.
213 intros HForall2.
214 unfold map_Forall2, map_relation, option_relation in HForall2.
215 pose proof (HForall2 i). clear HForall2.
216 case_match.
217 - case_match; try done.
218 exists b, (delete i m2).
219 split.
220 * apply lookup_delete.
221 * by rewrite insert_delete_insert, insert_id.
222 - case_match; try done.
223 by rewrite lookup_insert in H8.
224Qed.
225
226Lemma map_Forall2_insert_inv `{FinMap K M} {A B}
227 (m1 : M A) (m2 : M B) R i x y :
228 map_Forall2 R (<[i := x]>m1) (<[i := y]>m2) →
229 R x y ∧ map_Forall2 R (delete i m1) (delete i m2).
230Proof.
231 intros HForall2.
232 unfold map_Forall2, map_relation, option_relation in HForall2.
233 pose proof (HForall2 i).
234 case_match.
235 - case_match; try done.
236 rewrite lookup_insert in H8. rewrite lookup_insert in H9.
237 simplify_eq /=. split; try done.
238 unfold map_Forall2, map_relation, option_relation.
239 intros j.
240 destruct (decide (i = j)).
241 + simplify_option_eq.
242 case_match.
243 * by rewrite lookup_delete in H8.
244 * case_match; [|done].
245 by rewrite lookup_delete in H9.
246 + case_match; case_match;
247 rewrite lookup_delete_ne in H8 by done;
248 rewrite lookup_delete_ne in H9 by done;
249 pose proof (HForall2 j);
250 case_match; case_match; try done;
251 rewrite lookup_insert_ne in H11 by done;
252 rewrite lookup_insert_ne in H12 by done;
253 by simplify_eq /=.
254 - by rewrite lookup_insert in H8.
255Qed.
256
257Lemma map_Forall2_insert_inv_strict `{FinMap K M} {A B}
258 (m1 : M A) (m2 : M B) R i x y :
259 m1 !! i = None →
260 m2 !! i = None →
261 map_Forall2 R (<[i := x]>m1) (<[i := y]>m2) →
262 R x y ∧ map_Forall2 R m1 m2.
263Proof.
264 intros Him1 Him2 HForall2.
265 apply map_Forall2_insert_inv in HForall2 as [HPixy HForall2].
266 split; try done.
267 apply delete_notin in Him1, Him2.
268 by rewrite Him1, Him2 in HForall2.
269Qed.
270
271Lemma map_Forall2_dom_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
272 (R : A → B → Prop) (m1 : M A) (m2 : M B) :
273 map_Forall2 R m1 m2 → dom m1 = dom m2.
274Proof.
275 revert m2.
276 induction m1 using map_ind; intros m2.
277 - intros HForall2.
278 destruct m2 using map_ind; [set_solver|].
279 unfold map_Forall2, map_relation, option_relation in HForall2.
280 pose proof (HForall2 i). by rewrite lookup_empty, lookup_insert in H15.
281 - intros HForall2.
282 apply map_Forall2_destruct in HForall2 as Hm2.
283 destruct Hm2 as [y [m2' [Hm21 Hm22]]]. simplify_eq /=.
284 apply map_Forall2_insert_inv_strict in HForall2 as [_ HForall2]; try done.
285 set_solver.
286Qed.
287
288Lemma map_Forall2_empty_l_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
289 (R : A → B → Prop) (m2 : M B) :
290 map_Forall2 R ∅ m2 → m2 = ∅.
291Proof.
292 intros HForall2.
293 apply map_Forall2_dom_L in HForall2 as Hdom.
294 rewrite dom_empty_L in Hdom.
295 symmetry in Hdom.
296 by apply dom_empty_inv_L in Hdom.
297Qed.
298
299Lemma map_Forall2_empty_r_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
300 (R : A → B → Prop) (m1 : M A) :
301 map_Forall2 R m1 ∅ → m1 = ∅.
302Proof.
303 intros HForall2.
304 apply map_Forall2_dom_L in HForall2 as Hdom.
305 rewrite dom_empty_L in Hdom.
306 by apply dom_empty_inv_L in Hdom.
307Qed.
308
309Lemma map_Forall2_empty `{FinMap K M} {A B} (R : A → B → Prop):
310 map_Forall2 R (∅ : M A) (∅ : M B).
311Proof.
312 unfold map_Forall2, map_relation.
313 intros i. by rewrite 2 lookup_empty.
314Qed.
315
316Lemma map_Forall2_impl_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
317 (R1 R2 : A → B → Prop) :
318 (∀ a b, R1 a b → R2 a b) →
319 ∀ (m1 : M A) (m2 : M B),
320 map_Forall2 R1 m1 m2 → map_Forall2 R2 m1 m2.
321Proof.
322 intros HR1R2 ?? HForall2.
323 unfold map_Forall2, map_relation, option_relation in *.
324 intros j. pose proof (HForall2 j). clear HForall2.
325 case_match; case_match; try done.
326 by apply HR1R2.
327Qed.
328
329Lemma map_Forall2_fmap_r_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B C}
330 (P : A → C → Prop) (m1 : M A) (m2 : M B) (f : B → C) :
331 map_Forall2 P m1 (f <$> m2) → map_Forall2 (λ l r, P l (f r)) m1 m2.
332Proof.
333 intros HForall2.
334 unfold map_Forall2, map_relation, option_relation in *.
335 intros j. pose proof (HForall2 j). clear HForall2.
336 case_match; case_match; try done; case_match;
337 rewrite lookup_fmap in H16; rewrite H17 in H16; by simplify_eq/=.
338Qed.
339
340Lemma map_Forall2_eq_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A}
341 (m1 m2 : M A) :
342 m1 = m2 ↔ map_Forall2 (=) m1 m2.
343Proof.
344 split; revert m2.
345 - induction m1 using map_ind; intros m2 Heq; inv Heq.
346 + apply map_Forall2_empty.
347 + apply map_Forall2_insert_L; try done. by apply IHm1.
348 - induction m1 using map_ind; intros m2 HForall2.
349 + by apply map_Forall2_empty_l_L in HForall2.
350 + apply map_Forall2_destruct in HForall2 as Hm.
351 destruct Hm as [y [m2' [Him2' Heqm2]]]. subst.
352 apply map_Forall2_insert_inv in HForall2 as [Heqxy HForall2].
353 rewrite 2 delete_notin in HForall2 by done.
354 apply IHm1 in HForall2. by subst.
355Qed.
356
357Lemma map_insert_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A}
358 (i : K) (x1 x2 : A) (m1 m2 : M A) :
359 x1 = x2 →
360 delete i m1 = delete i m2 →
361 <[i := x1]>m1 = <[i := x2]>m2.
362Proof.
363 intros Heq Hdel.
364 apply map_Forall2_eq_L.
365 eapply map_Forall2_insert_weak; [done|].
366 by apply map_Forall2_eq_L.
367Qed.
368
369Lemma map_insert_rev_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A}
370 (i : K) (x1 x2 : A) (m1 m2 : M A) :
371 <[i := x1]>m1 = <[i := x2]>m2 → x1 = x2 ∧ delete i m1 = delete i m2.
372Proof.
373 intros Heq. apply map_Forall2_eq_L in Heq.
374 apply map_Forall2_insert_inv in Heq as [Heq1 Heq2].
375 by apply map_Forall2_eq_L in Heq2.
376Qed.
377
378Lemma map_insert_rev_1_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A}
379 (i : K) (x1 x2 : A) (m1 m2 : M A) :
380 <[i := x1]>m1 = <[i := x2]>m2 → x1 = x2.
381Proof. apply map_insert_rev_L. Qed.
382
383Lemma map_insert_rev_2_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A}
384 (i : K) (x1 x2 : A) (m1 m2 : M A) :
385 <[i := x1]>m1 = <[i := x2]>m2 → delete i m1 = delete i m2.
386Proof. apply map_insert_rev_L. Qed.
387
388Lemma map_Forall2_alt_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
389 (R : A → B → Prop) (m1 : M A) (m2 : M B) :
390 map_Forall2 R m1 m2 ↔
391 dom m1 = dom m2 ∧ ∀ i x y, m1 !! i = Some x → m2 !! i = Some y → R x y.
392Proof.
393 split.
394 - intros HForall2.
395 split.
396 + by apply map_Forall2_dom_L in HForall2.
397 + intros i x y Him1 Him2.
398 unfold map_Forall2, map_relation, option_relation in HForall2.
399 pose proof (HForall2 i). clear HForall2.
400 by simplify_option_eq.
401 - intros [Hdom HForall2].
402 unfold map_Forall2, map_relation, option_relation.
403 intros j.
404 case_match; case_match; try done.
405 + by eapply HForall2.
406 + apply mk_is_Some in H14.
407 apply not_elem_of_dom in H15.
408 apply elem_of_dom in H14.
409 set_solver.
410 + apply not_elem_of_dom in H14.
411 apply mk_is_Some in H15.
412 apply elem_of_dom in H15.
413 set_solver.
414Qed.
415
416(** Relation between map_mapM and map_Forall2 *)
417
418Lemma map_mapM_Some_1_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
419 (f : A → option B) (m1 : M A) (m2 : M B) :
420 map_mapM f m1 = Some m2 → map_Forall2 (λ x y, f x = Some y) m1 m2.
421Proof.
422 revert m1 m2 f.
423 induction m1 using map_ind.
424 - intros m2 f Hmap_mapM.
425 unfold map_mapM in Hmap_mapM.
426 rewrite map_fold_empty in Hmap_mapM.
427 simplify_option_eq. apply map_Forall2_empty.
428 - intros m2 f Hmap_mapM.
429 csimpl in Hmap_mapM.
430 unfold map_mapM in Hmap_mapM.
431 csimpl in Hmap_mapM.
432 rewrite map_fold_insert_L in Hmap_mapM.
433 + simplify_option_eq.
434 apply IHm1 in Heqo.
435 apply map_Forall2_insert_L; try done.
436 apply not_elem_of_dom in H14.
437 apply not_elem_of_dom.
438 apply map_Forall2_dom_L in Heqo.
439 set_solver.
440 + intros.
441 destruct y; simplify_option_eq; try done.
442 destruct (f z2); simplify_option_eq.
443 * destruct (f z1); simplify_option_eq; try done.
444 f_equal. by apply insert_commute.
445 * destruct (f z1); by simplify_option_eq.
446 + done.
447Qed.
448
449Lemma map_mapM_Some_2_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
450 (f : A → option B) (m1 : M A) (m2 : M B) :
451 map_Forall2 (λ x y, f x = Some y) m1 m2 → map_mapM f m1 = Some m2.
452Proof.
453 revert m2.
454 induction m1 using map_ind; intros m2 HForall2.
455 - unfold map_mapM. rewrite map_fold_empty.
456 apply map_Forall2_empty_l_L in HForall2.
457 by simplify_eq.
458 - destruct (map_Forall2_destruct _ _ _ _ _ HForall2) as
459 [y [m2' [HForall21 HForall22]]]. subst.
460 destruct (map_Forall2_insert_inv_strict _ _ _ _ _ _ H14 HForall21 HForall2) as
461 [Hfy HForall22].
462 apply IHm1 in HForall22.
463 unfold map_mapM.
464 rewrite map_fold_insert_L; try by simplify_option_eq.
465 intros.
466 destruct y0; simplify_option_eq; try done.
467 destruct (f z2); simplify_option_eq.
468 * destruct (f z1); simplify_option_eq; try done.
469 f_equal. by apply insert_commute.
470 * destruct (f z1); by simplify_option_eq.
471Qed.
472
473Lemma map_mapM_Some_L `{FinMapDom K M D} `{!LeibnizEquiv D} {A B}
474 (f : A → option B) (m1 : M A) (m2 : M B) :
475 map_mapM f m1 = Some m2 ↔ map_Forall2 (λ x y, f x = Some y) m1 m2.
476Proof. split; [apply map_mapM_Some_1_L | apply map_mapM_Some_2_L]. Qed.