fin_maps.v 19 KB
Newer Older
1
2
3
4
5
6
(* Copyright (c) 2012, Robbert Krebbers. *)
(* This file is distributed under the terms of the BSD license. *)
(** Finite maps associate data to keys. This file defines an interface for
finite maps and collects some theory on it. Most importantly, it proves useful
induction principles for finite maps and implements the tactic [simplify_map]
to simplify goals involving finite maps. *)
Robbert Krebbers's avatar
Robbert Krebbers committed
7
8
Require Export prelude.

9
10
(** * Axiomatization of finite maps *)
(** We require Leibniz equality to be extensional on finite maps. This of
11
12
13
14
15
course limits the space of finite map implementations, but since we are mainly
interested in finite maps with numbers as indexes, we do not consider this to
be a serious limitation. The main application of finite maps is to implement
the memory, where extensionality of Leibniz equality is very important for a
convenient use in the assertions of our axiomatic semantics. *)
16
17
18
19
20
21
(** Finiteness is axiomatized by requiring each map to have a finite domain.
Since we may have multiple implementations of finite sets, the [dom] function is
parametrized by an implementation of finite sets over the map's key type. *)
(** Finite map implementations are required to implement the [merge] function
which enables us to give a generic implementation of [union_with],
[intersection_with], and [difference_with]. *)
22
23
24
Class FinMap K M `{Lookup K M} `{ A, Empty (M A)}
    `{ `(f : A  B), FMap M f} `{PartialAlter K M} `{Dom K M} `{Merge M}
    `{ i j : K, Decision (i = j)} := {
25
26
27
28
29
30
31
32
33
34
35
36
  finmap_eq {A} (m1 m2 : M A) :
    ( i, m1 !! i = m2 !! i)  m1 = m2;
  lookup_empty {A} i :
    ( : M A) !! i = None;
  lookup_partial_alter {A} f (m : M A) i :
    partial_alter f i m !! i = f (m !! i);
  lookup_partial_alter_ne {A} f (m : M A) i j :
    i  j  partial_alter f i m !! j = m !! j;
  lookup_fmap {A B} (f : A  B) (m : M A) i :
    (f <$> m) !! i = f <$> m !! i;
  elem_of_dom C {A} `{Collection K C} (m : M A) i :
    i  dom C m  is_Some (m !! i);
37
  merge_spec {A} f `{!PropHolds (f None None = None)}
Robbert Krebbers's avatar
Robbert Krebbers committed
38
39
40
    (m1 m2 : M A) i : merge f m1 m2 !! i = f (m1 !! i) (m2 !! i)
}.

41
42
43
44
45
(** * Derived operations *)
(** All of the following functions are defined in a generic way for arbitrary
finite map implementations. These generic implementations do not cause a
significant enough performance loss to make including them in the finite map
axiomatization worthwhile. *)
46
47
48
49
Instance finmap_alter `{PartialAlter K M} : Alter K M := λ A f,
  partial_alter (fmap f).
Instance finmap_insert `{PartialAlter K M} : Insert K M := λ A k x,
  partial_alter (λ _, Some x) k.
50
Instance finmap_delete `{PartialAlter K M} : Delete K M := λ A,
51
  partial_alter (λ _, None).
52
Instance finmap_singleton `{PartialAlter K M} {A}
53
  `{Empty (M A)} : Singleton (K * A) (M A) := λ p, <[fst p:=snd p]>.
Robbert Krebbers's avatar
Robbert Krebbers committed
54

55
56
Definition list_to_map `{Insert K M} {A} `{Empty (M A)}
  (l : list (K * A)) : M A := insert_list l .
Robbert Krebbers's avatar
Robbert Krebbers committed
57

Robbert Krebbers's avatar
Robbert Krebbers committed
58
Instance finmap_union_with `{Merge M} : UnionWith M := λ A f,
59
  merge (union_with f).
Robbert Krebbers's avatar
Robbert Krebbers committed
60
Instance finmap_intersection_with `{Merge M} : IntersectionWith M := λ A f,
61
  merge (intersection_with f).
Robbert Krebbers's avatar
Robbert Krebbers committed
62
Instance finmap_difference_with `{Merge M} : DifferenceWith M := λ A f,
63
  merge (difference_with f).
Robbert Krebbers's avatar
Robbert Krebbers committed
64

Robbert Krebbers's avatar
Robbert Krebbers committed
65
66
67
68
69
70
71
72
73
74
(** Two finite maps are disjoint if they do not have overlapping cells. *)
Instance finmap_disjoint `{Lookup K M} {A} : Disjoint (M A) := λ m1 m2,
   i, m1 !! i = None  m2 !! i = None.

(** The union of two finite maps only has a meaningful definition for maps
that are disjoint. However, as working with partial functions is inconvenient
in Coq, we define the union as a total function. In case both finite maps
have a value at the same index, we take the value of the first map. *)
Instance finmap_union `{Merge M} {A} : Union (M A) := union_with (λ x _ , x).

75
(** * General theorems *)
Robbert Krebbers's avatar
Robbert Krebbers committed
76
Section finmap.
77
Context `{FinMap K M} {A : Type}.
78
79
80
81

Global Instance finmap_subseteq: SubsetEq (M A) := λ m n,
   i x, m !! i = Some x  n !! i = Some x.
Global Instance: BoundedPreOrder (M A).
82
Proof. split; [firstorder |]. intros m i x. by rewrite lookup_empty. Qed.
83

84
85
Lemma lookup_weaken (m1 m2 : M A) i x :
  m1 !! i = Some x  m1  m2  m2 !! i = Some x.
86
Proof. auto. Qed.
87
88
Lemma lookup_weaken_None (m1 m2 : M A) i :
  m2 !! i = None  m1  m2  m1 !! i = None.
89
90
91
92
93
94
Proof. rewrite !eq_None_not_Some. firstorder. Qed.
Lemma lookup_ne (m : M A) i j : m !! i  m !! j  i  j.
Proof. congruence. Qed.

Lemma not_elem_of_dom C `{Collection K C} (m : M A) i :
  i  dom C m  m !! i = None.
95
Proof. by rewrite (elem_of_dom C), eq_None_not_Some. Qed.
96
97

Lemma finmap_empty (m : M A) : ( i, m !! i = None)  m = .
98
Proof. intros Hm. apply finmap_eq. intros. by rewrite Hm, lookup_empty. Qed.
99
100
101
Lemma dom_empty C `{Collection K C} : dom C ( : M A)  .
Proof.
  split; intro.
102
  * rewrite (elem_of_dom C), lookup_empty. by destruct 1.
103
  * solve_elem_of.
104
105
106
107
Qed.
Lemma dom_empty_inv C `{Collection K C} (m : M A) : dom C m    m = .
Proof.
  intros E. apply finmap_empty. intros. apply (not_elem_of_dom C).
108
  rewrite E. solve_elem_of.
109
110
111
Qed.

Lemma lookup_empty_not i : ¬is_Some (( : M A) !! i).
112
Proof. rewrite lookup_empty. by destruct 1. Qed.
113
Lemma lookup_empty_Some i (x : A) : ¬ !! i = Some x.
114
Proof. by rewrite lookup_empty. Qed.
115
116
117
118
119

Lemma partial_alter_compose (m : M A) i f g :
  partial_alter (f  g) i m = partial_alter f i (partial_alter g i m).
Proof.
  intros. apply finmap_eq. intros ii. case (decide (i = ii)).
120
121
  * intros. subst. by rewrite !lookup_partial_alter.
  * intros. by rewrite !lookup_partial_alter_ne.
122
123
124
125
126
127
128
Qed.
Lemma partial_alter_comm (m : M A) i j f g :
  i  j 
 partial_alter f i (partial_alter g j m) = partial_alter g j (partial_alter f i m).
Proof.
  intros. apply finmap_eq. intros jj.
  destruct (decide (jj = j)).
129
  * subst. by rewrite lookup_partial_alter_ne,
130
131
     !lookup_partial_alter, lookup_partial_alter_ne.
  * destruct (decide (jj = i)).
132
    + subst. by rewrite lookup_partial_alter,
133
       !lookup_partial_alter_ne, lookup_partial_alter by congruence.
134
    + by rewrite !lookup_partial_alter_ne by congruence.
135
136
137
138
139
140
Qed.
Lemma partial_alter_self_alt (m : M A) i x :
  x = m !! i  partial_alter (λ _, x) i m = m.
Proof.
  intros. apply finmap_eq. intros ii.
  destruct (decide (i = ii)).
141
142
  * subst. by rewrite lookup_partial_alter.
  * by rewrite lookup_partial_alter_ne.
143
144
Qed.
Lemma partial_alter_self (m : M A) i : partial_alter (λ _, m !! i) i m = m.
145
Proof. by apply partial_alter_self_alt. Qed.
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164

Lemma lookup_insert (m : M A) i x : <[i:=x]>m !! i = Some x.
Proof. unfold insert. apply lookup_partial_alter. Qed.
Lemma lookup_insert_rev (m : M A) i x y : <[i:= x ]>m !! i = Some y  x = y.
Proof. rewrite lookup_insert. congruence. Qed.
Lemma lookup_insert_ne (m : M A) i j x : i  j  <[i:=x]>m !! j = m !! j.
Proof. unfold insert. apply lookup_partial_alter_ne. Qed.
Lemma insert_comm (m : M A) i j x y :
  i  j  <[i:=x]>(<[j:=y]>m) = <[j:=y]>(<[i:=x]>m).
Proof. apply partial_alter_comm. Qed.

Lemma lookup_insert_Some (m : M A) i j x y :
  <[i:=x]>m !! j = Some y  (i = j  x = y)  (i  j  m !! j = Some y).
Proof.
  split.
  * destruct (decide (i = j)); subst;
      rewrite ?lookup_insert, ?lookup_insert_ne; intuition congruence.
  * intros [[??]|[??]].
    + subst. apply lookup_insert.
165
    + by rewrite lookup_insert_ne.
166
167
168
169
170
171
172
Qed.
Lemma lookup_insert_None (m : M A) i j x :
  <[i:=x]>m !! j = None  m !! j = None  i  j.
Proof.
  split.
  * destruct (decide (i = j)); subst;
      rewrite ?lookup_insert, ?lookup_insert_ne; intuition congruence.
173
  * intros [??]. by rewrite lookup_insert_ne.
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
Qed.

Lemma lookup_singleton_Some i j (x y : A) :
  {[(i, x)]} !! j = Some y  i = j  x = y.
Proof.
  unfold singleton, finmap_singleton.
  rewrite lookup_insert_Some, lookup_empty. simpl.
  intuition congruence.
Qed.
Lemma lookup_singleton_None i j (x : A) :
  {[(i, x)]} !! j = None  i  j.
Proof.
  unfold singleton, finmap_singleton.
  rewrite lookup_insert_None, lookup_empty. simpl. tauto.
Qed.
189
190
191
192
193
Lemma insert_singleton i (x y : A) : <[i:=y]>{[(i, x)]} = {[(i, y)]}.
Proof.
  unfold singleton, finmap_singleton, insert, finmap_insert.
  by rewrite <-partial_alter_compose.
Qed.
194
195

Lemma lookup_singleton i (x : A) : {[(i, x)]} !! i = Some x.
196
Proof. by rewrite lookup_singleton_Some. Qed.
197
Lemma lookup_singleton_ne i j (x : A) : i  j  {[(i, x)]} !! j = None.
198
Proof. by rewrite lookup_singleton_None. Qed.
199
200
201
202
203
204
205
206
207
208
209
210

Lemma lookup_delete (m : M A) i : delete i m !! i = None.
Proof. apply lookup_partial_alter. Qed.
Lemma lookup_delete_ne (m : M A) i j : i  j  delete i m !! j = m !! j.
Proof. apply lookup_partial_alter_ne. Qed.

Lemma lookup_delete_Some (m : M A) i j y :
  delete i m !! j = Some y  i  j  m !! j = Some y.
Proof.
  split.
  * destruct (decide (i = j)); subst;
      rewrite ?lookup_delete, ?lookup_delete_ne; intuition congruence.
211
  * intros [??]. by rewrite lookup_delete_ne.
212
213
214
215
216
217
218
219
220
221
Qed.
Lemma lookup_delete_None (m : M A) i j :
  delete i m !! j = None  i = j  m !! j = None.
Proof.
  destruct (decide (i = j)).
  * subst. rewrite lookup_delete. tauto.
  * rewrite lookup_delete_ne; tauto.
Qed.

Lemma delete_empty i : delete i ( : M A) = .
222
Proof. rewrite <-(partial_alter_self ) at 2. by rewrite lookup_empty. Qed.
223
224
225
Lemma delete_singleton i (x : A) : delete i {[(i, x)]} = .
Proof. setoid_rewrite <-partial_alter_compose. apply delete_empty. Qed.
Lemma delete_comm (m : M A) i j : delete i (delete j m) = delete j (delete i m).
226
Proof. destruct (decide (i = j)). by subst. by apply partial_alter_comm. Qed.
227
228
Lemma delete_insert_comm (m : M A) i j x :
  i  j  delete i (<[j:=x]>m) = <[j:=x]>(delete i m).
229
Proof. intro. by apply partial_alter_comm. Qed.
230
231
232
233
234

Lemma delete_notin (m : M A) i : m !! i = None  delete i m = m.
Proof.
  intros. apply finmap_eq. intros j.
  destruct (decide (i = j)).
235
236
  * subst. by rewrite lookup_delete.
  * by apply lookup_delete_ne.
237
238
239
240
241
Qed.

Lemma delete_partial_alter (m : M A) i f :
  m !! i = None  delete i (partial_alter f i m) = m.
Proof.
242
  intros. unfold delete, finmap_delete. rewrite <-partial_alter_compose.
243
244
  rapply partial_alter_self_alt. congruence.
Qed.
245
Lemma delete_partial_alter_dom C `{Collection K C} (m : M A) i f :
246
247
248
249
250
251
252
253
254
255
256
  i  dom C m  delete i (partial_alter f i m) = m.
Proof. rewrite (not_elem_of_dom C). apply delete_partial_alter. Qed.
Lemma delete_insert (m : M A) i x : m !! i = None  delete i (<[i:=x]>m) = m.
Proof. apply delete_partial_alter. Qed.
Lemma delete_insert_dom C `{Collection K C} (m : M A) i x :
  i  dom C m  delete i (<[i:=x]>m) = m.
Proof. rewrite (not_elem_of_dom C). apply delete_partial_alter. Qed.
Lemma insert_delete (m : M A) i x : m !! i = Some x  <[i:=x]>(delete i m) = m.
Proof.
  intros Hmi. unfold delete, finmap_delete, insert, finmap_insert.
  rewrite <-partial_alter_compose. unfold compose. rewrite <-Hmi.
257
  by apply partial_alter_self_alt.
258
259
260
261
262
263
Qed.

Lemma elem_of_dom_delete C `{Collection K C} (m : M A) i j :
  i  dom C (delete j m)  i  j  i  dom C m.
Proof.
  rewrite !(elem_of_dom C). unfold is_Some.
264
  setoid_rewrite lookup_delete_Some. naive_solver.
265
266
267
268
Qed.
Lemma not_elem_of_dom_delete C `{Collection K C} (m : M A) i :
  i  dom C (delete i m).
Proof. apply (not_elem_of_dom C), lookup_delete. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
269

270
271
272
273
274
275
276
277
278
279
280
281
(** * Induction principles *)
(** We use the induction principle on finite collections to prove the
following induction principle on finite maps. *)
Lemma finmap_ind_alt C (P : M A  Prop) `{FinCollection K C} :
  P  
  ( i x m, i  dom C m  P m  P (<[i:=x]>m)) 
   m, P m.
Proof.
  intros Hemp Hinsert m.
  apply (collection_ind (λ X,  m, dom C m  X  P m)) with (dom C m).
  * solve_proper.
  * clear m. intros m Hm. rewrite finmap_empty.
282
    + done.
283
    + intros. rewrite <-(not_elem_of_dom C), Hm.
284
      by solve_elem_of.
285
286
287
288
  * clear m. intros i X Hi IH m Hdom.
    assert (is_Some (m !! i)) as [x Hx].
    { apply (elem_of_dom C).
      rewrite Hdom. clear Hdom.
289
290
      by solve_elem_of. }
    rewrite <-(insert_delete m i x) by done.
291
    apply Hinsert.
292
    { by apply (not_elem_of_dom_delete C). }
293
294
295
    apply IH. apply elem_of_equiv. intros.
    rewrite (elem_of_dom_delete C).
    esolve_elem_of.
296
  * done.
297
298
299
300
301
302
303
304
305
306
307
308
309
310
Qed.

(** We use the [listset] implementation to prove an induction principle that
does not mention the map's domain. *)
Lemma finmap_ind (P : M A  Prop) :
  P  
  ( i x m, m !! i = None  P m  P (<[i:=x]>m)) 
   m, P m.
Proof.
  setoid_rewrite <-(not_elem_of_dom (listset _)).
  apply (finmap_ind_alt (listset _) P).
Qed.

(** * Deleting and inserting multiple elements *)
311
312
313
Lemma lookup_delete_list (m : M A) is j :
  In j is  delete_list is m !! j = None.
Proof.
314
  induction is as [|i is]; simpl; [done |].
315
  intros [?|?].
316
  * subst. by rewrite lookup_delete.
317
  * destruct (decide (i = j)).
318
    + subst. by rewrite lookup_delete.
319
320
321
322
323
    + rewrite lookup_delete_ne; auto.
Qed.
Lemma lookup_delete_list_notin (m : M A) is j :
  ¬In j is  delete_list is m !! j = m !! j.
Proof.
324
  induction is; simpl; [done |].
325
326
327
328
329
330
  intros. rewrite lookup_delete_ne; tauto.
Qed.

Lemma delete_list_notin (m : M A) is :
  Forall (λ i, m !! i = None) is  delete_list is m = m.
Proof.
331
  induction 1; simpl; [done |].
332
333
334
335
336
  rewrite delete_notin; congruence.
Qed.
Lemma delete_list_insert_comm (m : M A) is j x :
  ¬In j is  delete_list is (<[j:=x]>m) = <[j:=x]>(delete_list is m).
Proof.
337
  induction is; simpl; [done |].
338
339
340
  intros. rewrite IHis, delete_insert_comm; tauto.
Qed.

341
342
Lemma lookup_insert_list (m : M A) l1 l2 i x :
  (y, ¬In (i,y) l1)  insert_list (l1 ++ (i,x) :: l2) m !! i = Some x.
343
Proof.
344
  induction l1 as [|[j y] l1 IH]; simpl.
345
  * intros. by rewrite lookup_insert.
346
347
348
349
350
351
352
  * intros Hy. rewrite lookup_insert_ne; naive_solver.
Qed.

Lemma lookup_insert_list_not_in (m : M A) l i :
  (y, ¬In (i,y) l)  insert_list l m !! i = m !! i.
Proof.
  induction l as [|[j y] l IH]; simpl.
353
  * done.
354
  * intros Hy. rewrite lookup_insert_ne; naive_solver.
355
356
Qed.

357
(** * Properties of the merge operation *)
358
359
360
361
Section merge.
  Context (f : option A  option A  option A).

  Global Instance: LeftId (=) None f  LeftId (=)  (merge f).
Robbert Krebbers's avatar
Robbert Krebbers committed
362
  Proof.
363
    intros ??. apply finmap_eq. intros.
364
    by rewrite !(merge_spec f), lookup_empty, (left_id None f).
Robbert Krebbers's avatar
Robbert Krebbers committed
365
  Qed.
366
  Global Instance: RightId (=) None f  RightId (=)  (merge f).
Robbert Krebbers's avatar
Robbert Krebbers committed
367
  Proof.
368
    intros ??. apply finmap_eq. intros.
369
    by rewrite !(merge_spec f), lookup_empty, (right_id None f).
Robbert Krebbers's avatar
Robbert Krebbers committed
370
  Qed.
371
  Global Instance: Idempotent (=) f  Idempotent (=) (merge f).
372
  Proof. intros ??. apply finmap_eq. intros. by rewrite !(merge_spec f). Qed.
373
374
375
376
377

  Context `{!PropHolds (f None None = None)}.

  Lemma merge_spec_alt m1 m2 m :
    ( i, m !! i = f (m1 !! i) (m2 !! i))  merge f m1 m2 = m.
Robbert Krebbers's avatar
Robbert Krebbers committed
378
  Proof.
379
380
381
    split; [| intro; subst; apply (merge_spec _) ].
    intros Hlookup. apply finmap_eq. intros. rewrite Hlookup.
    apply (merge_spec _).
Robbert Krebbers's avatar
Robbert Krebbers committed
382
  Qed.
383
384
385
386

  Lemma merge_comm m1 m2 :
    ( i, f (m1 !! i) (m2 !! i) = f (m2 !! i) (m1 !! i)) 
    merge f m1 m2 = merge f m2 m1.
387
  Proof. intros. apply finmap_eq. intros. by rewrite !(merge_spec f). Qed.
388
  Global Instance: Commutative (=) f  Commutative (=) (merge f).
389
  Proof. intros ???. apply merge_comm. intros. by apply (commutative f). Qed.
390
391

  Lemma merge_assoc m1 m2 m3 :
392
393
    ( i, f (m1 !! i) (f (m2 !! i) (m3 !! i)) =
          f (f (m1 !! i) (m2 !! i)) (m3 !! i)) 
394
    merge f m1 (merge f m2 m3) = merge f (merge f m1 m2) m3.
395
  Proof. intros. apply finmap_eq. intros. by rewrite !(merge_spec f). Qed.
396
  Global Instance: Associative (=) f  Associative (=) (merge f).
397
  Proof. intros ????. apply merge_assoc. intros. by apply (associative f). Qed.
398
399
End merge.

400
(** * Properties of the union and intersection operation *)
401
402
403
Section union_intersection.
  Context (f : A  A  A).

Robbert Krebbers's avatar
Robbert Krebbers committed
404
  Lemma finmap_union_with_merge m1 m2 i x y :
405
406
407
    m1 !! i = Some x 
    m2 !! i = Some y 
    union_with f m1 m2 !! i = Some (f x y).
408
  Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
409
    intros Hx Hy. unfold union_with, finmap_union_with.
410
    by rewrite (merge_spec _), Hx, Hy.
411
  Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
412
  Lemma finmap_union_with_l m1 m2 i x :
413
    m1 !! i = Some x  m2 !! i = None  union_with f m1 m2 !! i = Some x.
414
  Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
415
    intros Hx Hy. unfold union_with, finmap_union_with.
416
    by rewrite (merge_spec _), Hx, Hy.
417
  Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
418
  Lemma finmap_union_with_r m1 m2 i y :
419
    m1 !! i = None  m2 !! i = Some y  union_with f m1 m2 !! i = Some y.
Robbert Krebbers's avatar
Robbert Krebbers committed
420
  Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
421
    intros Hx Hy. unfold union_with, finmap_union_with.
422
    by rewrite (merge_spec _), Hx, Hy.
Robbert Krebbers's avatar
Robbert Krebbers committed
423
  Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
424
  Lemma finmap_union_with_None m1 m2 i :
425
    union_with f m1 m2 !! i = None  m1 !! i = None  m2 !! i = None.
Robbert Krebbers's avatar
Robbert Krebbers committed
426
  Proof.
Robbert Krebbers's avatar
Robbert Krebbers committed
427
    unfold union_with, finmap_union_with. rewrite (merge_spec _).
428
    destruct (m1 !! i), (m2 !! i); compute; intuition congruence.
Robbert Krebbers's avatar
Robbert Krebbers committed
429
430
  Qed.

431
432
433
434
435
436
437
438
439
  Global Instance: LeftId (=)  (union_with f : M A  M A  M A) := _.
  Global Instance: RightId (=)  (union_with f : M A  M A  M A) := _.
  Global Instance:
    Commutative (=) f  Commutative (=) (union_with f : M A  M A  M A) := _.
  Global Instance:
    Associative (=) f  Associative (=) (union_with f : M A  M A  M A) := _.
  Global Instance:
    Idempotent (=) f  Idempotent (=) (union_with f : M A  M A  M A) := _.
End union_intersection.
Robbert Krebbers's avatar
Robbert Krebbers committed
440
441
442
443
444
445
446
447
448
449
450
451

Lemma finmap_union_Some (m1 m2 : M A) i x :
  (m1  m2) !! i = Some x 
    m1 !! i = Some x  (m1 !! i = None  m2 !! i = Some x).
Proof.
  unfold union, finmap_union, union_with, finmap_union_with.
  rewrite (merge_spec _).
  destruct (m1 !! i), (m2 !! i); compute; try intuition congruence.
Qed.
Lemma finmap_union_None (m1 m2 : M A) b :
  (m1  m2) !! b = None  m1 !! b = None  m2 !! b = None.
Proof. apply finmap_union_with_None. Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
452
End finmap.
453

454
455
(** * The finite map tactic *)
(** The tactic [simplify_map by tac] simplifies finite map expressions
456
occuring in the conclusion and hypotheses. It uses [tac] to discharge generated
457
inequalities. *)
458
Tactic Notation "simplify_map" "by" tactic3(tac) := repeat
459
  match goal with
460
461
  | H1 : ?m !! ?i = Some ?x, H2 : ?m !! ?i = Some ?y |- _ =>
    assert (x = y) by congruence; subst y; clear H2
462
463
  | H : context[  !! _ ] |- _ => rewrite lookup_empty in H
  | H : context[ (<[_:=_]>_) !! _ ] |- _ => rewrite lookup_insert in H
464
  | H : context[ (<[_:=_]>_) !! _ ] |- _ => rewrite lookup_insert_ne in H by tac
465
  | H : context[ (delete _ _) !! _ ] |- _ => rewrite lookup_delete in H
466
  | H : context[ (delete _ _) !! _ ] |- _ => rewrite lookup_delete_ne in H by tac
467
  | H : context[ {[ _ ]} !! _ ] |- _ => rewrite lookup_singleton in H
468
  | H : context[ {[ _ ]} !! _ ] |- _ => rewrite lookup_singleton_ne in H by tac
469
470
  | |- context[  !! _ ] => rewrite lookup_empty
  | |- context[ (<[_:=_]>_) !! _ ] => rewrite lookup_insert
471
  | |- context[ (<[_:=_]>_) !! _ ] => rewrite lookup_insert_ne by tac
472
  | |- context[ (delete _ _) !! _ ] => rewrite lookup_delete
473
  | |- context[ (delete _ _) !! _ ] => rewrite lookup_delete_ne by tac
474
  | |- context[ {[ _ ]} !! _ ] => rewrite lookup_singleton
475
  | |- context[ {[ _ ]} !! _ ] => rewrite lookup_singleton_ne by tac
476
477
  end.
Tactic Notation "simplify_map" := simplify_map by auto.
478
479
480
481

Tactic Notation "simplify_map_equality" "by" tactic3(tac) :=
  repeat first [ progress (simplify_map by tac) | progress simplify_equality ].
Tactic Notation "simplify_map_equality" := simplify_map_equality by auto.