list.v 125 KB
Newer Older
1
(* Copyright (c) 2012-2013, Robbert Krebbers. *)
2 3 4
(* This file is distributed under the terms of the BSD license. *)
(** This file collects general purpose definitions and theorems on lists that
are not in the Coq standard library. *)
5
Require Export Permutation.
6
Require Export numbers base decidable option.
Robbert Krebbers's avatar
Robbert Krebbers committed
7

8
Arguments length {_} _.
Robbert Krebbers's avatar
Robbert Krebbers committed
9 10 11
Arguments cons {_} _ _.
Arguments app {_} _ _.
Arguments Permutation {_} _ _.
12
Arguments Forall_cons {_} _ _ _ _ _.
Robbert Krebbers's avatar
Robbert Krebbers committed
13

14 15 16
Notation tail := tl.
Notation take := firstn.
Notation drop := skipn.
17

18 19 20
Arguments take {_} !_ !_ /.
Arguments drop {_} !_ !_ /.

Robbert Krebbers's avatar
Robbert Krebbers committed
21 22 23 24 25 26 27
Notation "(::)" := cons (only parsing) : C_scope.
Notation "( x ::)" := (cons x) (only parsing) : C_scope.
Notation "(:: l )" := (λ x, cons x l) (only parsing) : C_scope.
Notation "(++)" := app (only parsing) : C_scope.
Notation "( l ++)" := (app l) (only parsing) : C_scope.
Notation "(++ k )" := (λ l, app l k) (only parsing) : C_scope.

28 29 30 31 32 33 34 35 36
Infix "≡ₚ" := Permutation (at level 70, no associativity) : C_scope.
Notation "(≡ₚ)" := Permutation (only parsing) : C_scope.
Notation "( x ≡ₚ)" := (Permutation x) (only parsing) : C_scope.
Notation "(≡ₚ x )" := (λ y, y  x) (only parsing) : C_scope.
Notation "(≢ₚ)" := (λ x y, ¬x  y) (only parsing) : C_scope.
Notation "x ≢ₚ y":= (¬x  y) (at level 70, no associativity) : C_scope.
Notation "( x ≢ₚ)" := (λ y, x ≢ₚ y) (only parsing) : C_scope.
Notation "(≢ₚ x )" := (λ y, y ≢ₚ x) (only parsing) : C_scope.

37 38 39
(** * Definitions *)
(** The operation [l !! i] gives the [i]th element of the list [l], or [None]
in case [i] is out of bounds. *)
Robbert Krebbers's avatar
Robbert Krebbers committed
40
Instance list_lookup {A} : Lookup nat A (list A) :=
41
  fix go (i : nat) (l : list A) {struct l} : option A :=
42 43
  match l with
  | [] => None
44
  | x :: l => match i with 0 => Some x | S i => @lookup _ _ _ go i l end
45
  end.
46 47 48

(** The operation [alter f i l] applies the function [f] to the [i]th element
of [l]. In case [i] is out of bounds, the list is returned unchanged. *)
Robbert Krebbers's avatar
Robbert Krebbers committed
49
Instance list_alter {A} (f : A  A) : AlterD nat A (list A) f :=
50
  fix go (i : nat) (l : list A) {struct l} :=
51 52
  match l with
  | [] => []
53
  | x :: l => match i with 0 => f x :: l | S i => x :: @alter _ _ _ f go i l end
54
  end.
55

56 57 58 59
(** The operation [<[i:=x]> l] overwrites the element at position [i] with the
value [x]. In case [i] is out of bounds, the list is returned unchanged. *)
Instance list_insert {A} : Insert nat A (list A) := λ i x, alter (λ _, x) i.

60 61 62
(** The operation [delete i l] removes the [i]th element of [l] and moves
all consecutive elements one position ahead. In case [i] is out of bounds,
the list is returned unchanged. *)
63 64
Instance list_delete {A} : Delete nat (list A) :=
  fix go (i : nat) (l : list A) {struct l} : list A :=
65 66
  match l with
  | [] => []
67
  | x :: l => match i with 0 => l | S i => x :: @delete _ _ go i l end
68
  end.
69 70 71

(** The function [option_list o] converts an element [Some x] into the
singleton list [[x]], and [None] into the empty list [[]]. *)
Robbert Krebbers's avatar
Robbert Krebbers committed
72 73 74 75 76 77 78 79 80
Definition option_list {A} : option A  list A := option_rect _ (λ x, [x]) [].

(** The function [filter P l] returns the list of elements of [l] that
satisfies [P]. The order remains unchanged. *)
Instance list_filter {A} : Filter A (list A) :=
  fix go P _ l :=
  match l with
  | [] => []
  | x :: l =>
81 82 83
    if decide (P x)
    then x :: @filter _ _ (@go) _ _ l
    else @filter _ _ (@go) _ _ l
Robbert Krebbers's avatar
Robbert Krebbers committed
84
  end.
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
Fixpoint filter_Some {A} (l : list (option A)) : list A :=
  match l with
  | [] => []
  | Some x :: l => x :: filter_Some l
  | None :: l => filter_Some l
  end.

(** The function [list_find P l] returns the first index [i] whose element
satisfies the predicate [P]. *)
Definition list_find {A} P `{ x, Decision (P x)} : list A  option nat :=
  fix go l :=
  match l with
  | [] => None
  | x :: l => if decide (P x) then Some 0 else S <$> go l
  end.
Robbert Krebbers's avatar
Robbert Krebbers committed
100 101 102 103

(** The function [replicate n x] generates a list with length [n] of elements
with value [x]. *)
Fixpoint replicate {A} (n : nat) (x : A) : list A :=
104
  match n with 0 => [] | S n => x :: replicate n x end.
Robbert Krebbers's avatar
Robbert Krebbers committed
105 106 107 108

(** The function [reverse l] returns the elements of [l] in reverse order. *)
Definition reverse {A} (l : list A) : list A := rev_append l [].

109
Fixpoint last' {A} (x : A) (l : list A) : A :=
110
  match l with [] => x | x :: l => last' x l end.
111
Definition last {A} (l : list A) : option A :=
112
  match l with [] => None | x :: l => Some (last' x l) end.
113

Robbert Krebbers's avatar
Robbert Krebbers committed
114 115 116 117 118 119
(** The function [resize n y l] takes the first [n] elements of [l] in case
[length l ≤ n], and otherwise appends elements with value [x] to [l] to obtain
a list of length [n]. *)
Fixpoint resize {A} (n : nat) (y : A) (l : list A) : list A :=
  match l with
  | [] => replicate n y
120
  | x :: l => match n with 0 => [] | S n => x :: resize n y l end
Robbert Krebbers's avatar
Robbert Krebbers committed
121 122 123
  end.
Arguments resize {_} !_ _ !_.

124 125 126 127 128
Definition sublist_lookup {A} (i n : nat) (l : list A) : option (list A) :=
  guard (i + n  length l); Some $ take n $ drop i l.
Definition sublist_insert {A} (i : nat) (k l : list A) : list A :=
  take i l ++ take (length l - i) k ++ drop (i + length k) l.

129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
(** Functions to fold over a list. We redefine [foldl] with the arguments in
the same order as in Haskell. *)
Notation foldr := fold_right.

Definition foldl {A B} (f : A  B  A) : A  list B  A :=
  fix go a l :=
  match l with
  | [] => a
  | x :: l => go (f a x) l
  end.

(** The monadic operations. *)
Instance list_ret: MRet list := λ A x, x :: @nil A.
Instance list_fmap {A B} (f : A  B) : FMapD list f :=
  fix go (l : list A) :=
144
  match l with [] => [] | x :: l => f x :: @fmap _ _ _ f go l end.
145 146
Instance list_bind {A B} (f : A  list B) : MBindD list f :=
  fix go (l : list A) :=
147
  match l with [] => [] | x :: l => f x ++ @mbind _ _ _ f go l end.
148 149
Instance list_join: MJoin list :=
  fix go A (ls : list (list A)) : list A :=
150
  match ls with [] => [] | l :: ls => l ++ @mjoin _ go _ ls end.
151 152 153 154 155 156 157
Definition mapM `{!MBind M} `{!MRet M} {A B}
    (f : A  M B) : list A  M (list B) :=
  fix go l :=
  match l with
  | [] => mret []
  | x :: l => y  f x; k  go l; mret (y :: k)
  end.
158 159 160 161 162

(** We define stronger variants of map and fold that allow the mapped
function to use the index of the elements. *)
Definition imap_go {A B} (f : nat  A  B) : nat  list A  list B :=
  fix go (n : nat) (l : list A) :=
163
  match l with [] => [] | x :: l => f n x :: go (S n) l end.
164 165
Definition imap {A B} (f : nat  A  B) : list A  list B := imap_go f 0.

166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
Definition ifoldr {A B} (f : nat  B  A  A) (a : nat  A) :
  nat  list B  A := fix go n l :=
  match l with [] => a n | b :: l => f n b (go (S n) l) end.

Definition zipped_map {A B} (f : list A  list A  A  B) :
  list A  list A  list B := fix go l k :=
  match k with [] => [] | x :: k => f l k x :: go (x :: l) k end.

Inductive zipped_Forall {A} (P : list A  list A  A  Prop) :
    list A  list A  Prop :=
  | zipped_Forall_nil l : zipped_Forall P l []
  | zipped_Forall_cons l k x :
     P l k x  zipped_Forall P (x :: l) k  zipped_Forall P l (x :: k).
Arguments zipped_Forall_nil {_ _} _.
Arguments zipped_Forall_cons {_ _} _ _ _ _ _.
181 182 183 184

(** Zipping lists. *)
Definition zip_with {A B C} (f : A  B  C) : list A  list B  list C :=
  fix go l1 l2 :=
185
  match l1, l2 with x1 :: l1, x2 :: l2 => f x1 x2 :: go l1 l2 | _ , _ => [] end.
186 187 188 189 190 191 192 193 194 195 196 197 198 199
Notation zip := (zip_with pair).

(** The function [permutations l] yields all permutations of [l]. *)
Fixpoint interleave {A} (x : A) (l : list A) : list (list A) :=
  match l with
  | [] => [ [x] ]
  | y :: l => (x :: y :: l) :: ((y ::) <$> interleave x l)
  end.
Fixpoint permutations {A} (l : list A) : list (list A) :=
  match l with
  | [] => [ [] ]
  | x :: l => permutations l = interleave x
  end.

200 201
(** The predicate [suffix_of] holds if the first list is a suffix of the second.
The predicate [prefix_of] holds if the first list is a prefix of the second. *)
202 203
Definition suffix_of {A} : relation (list A) := λ l1 l2,  k, l2 = k ++ l1.
Definition prefix_of {A} : relation (list A) := λ l1 l2,  k, l2 = l1 ++ k.
204 205
Infix "`suffix_of`" := suffix_of (at level 70) : C_scope.
Infix "`prefix_of`" := prefix_of (at level 70) : C_scope.
Robbert Krebbers's avatar
Robbert Krebbers committed
206

207 208 209 210 211 212 213 214 215
Section prefix_suffix_ops.
  Context `{ x y : A, Decision (x = y)}.

  Definition max_prefix_of : list A  list A  list A * list A * list A :=
    fix go l1 l2 :=
    match l1, l2 with
    | [], l2 => ([], l2, [])
    | l1, [] => (l1, [], [])
    | x1 :: l1, x2 :: l2 =>
216 217 218
      if decide_rel (=) x1 x2
      then snd_map (x1 ::) (go l1 l2)
      else (x1 :: l1, x2 :: l2, [])
219 220 221 222 223 224 225 226 227
    end.
  Definition max_suffix_of (l1 l2 : list A) : list A * list A * list A :=
    match max_prefix_of (reverse l1) (reverse l2) with
    | (k1, k2, k3) => (reverse k1, reverse k2, reverse k3)
    end.

  Definition strip_prefix (l1 l2 : list A) := snd $ fst $ max_prefix_of l1 l2.
  Definition strip_suffix (l1 l2 : list A) := snd $ fst $ max_suffix_of l1 l2.
End prefix_suffix_ops.
Robbert Krebbers's avatar
Robbert Krebbers committed
228

229
(** A list [l1] is a sublist of [l2] if [l2] is obtained by removing elements
230 231 232
from [l1] without changing the order. *)
Inductive sublist {A} : relation (list A) :=
  | sublist_nil : sublist [] []
233
  | sublist_skip x l1 l2 : sublist l1 l2  sublist (x :: l1) (x :: l2)
234
  | sublist_cons x l1 l2 : sublist l1 l2  sublist l1 (x :: l2).
235 236 237 238 239 240 241 242
Infix "`sublist`" := sublist (at level 70) : C_scope.

(** A list [l2] contains a list [l1] if [l2] is obtained by removing elements
from [l1] without changing the order. *)
Inductive contains {A} : relation (list A) :=
  | contains_nil : contains [] []
  | contains_skip x l1 l2 : contains l1 l2  contains (x :: l1) (x :: l2)
  | contains_swap x y l : contains (y :: x :: l) (x :: y :: l)
243
  | contains_cons x l1 l2 : contains l1 l2  contains l1 (x :: l2)
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260
  | contains_trans l1 l2 l3 : contains l1 l2  contains l2 l3  contains l1 l3.
Infix "`contains`" := contains (at level 70) : C_scope.

Section contains_dec_help.
  Context {A} {dec :  x y : A, Decision (x = y)}.

  Fixpoint list_remove (x : A) (l : list A) : option (list A) :=
    match l with
    | [] => None
    | y :: l => if decide (x = y) then Some l else (y ::) <$> list_remove x l
    end.
  Fixpoint list_remove_list (k : list A) (l : list A) : option (list A) :=
    match k with
    | [] => Some l
    | x :: k => list_remove x l = list_remove_list k
    end.
End contains_dec_help.
261

262 263 264 265
(** The [same_length] view allows convenient induction over two lists with the
same length. *)
Inductive same_length {A B} : list A  list B  Prop :=
  | same_length_nil : same_length [] []
266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315
  | same_length_cons x1 x2 l1 l2 :
     same_length l1 l2  same_length (x1 :: l1) (x2 :: l2).
Infix "`same_length`" := same_length (at level 70) : C_scope.

(** Set operations on lists *)
Section list_set.
  Context {A} {dec :  x y : A, Decision (x = y)}.

  Global Instance elem_of_list_dec {dec :  x y : A, Decision (x = y)}
    (x : A) :  l, Decision (x  l).
  Proof.
   refine (
    fix go l :=
    match l return Decision (x  l) with
    | [] => right _
    | y :: l => cast_if_or (decide (x = y)) (go l)
    end); clear go dec; subst; try (by constructor); abstract by inversion 1.
  Defined.

  Fixpoint remove_dups (l : list A) : list A :=
    match l with
    | [] => []
    | x :: l =>
      if decide_rel () x l then remove_dups l else x :: remove_dups l
    end.

  Fixpoint list_difference (l k : list A) : list A :=
    match l with
    | [] => []
    | x :: l =>
      if decide_rel () x k
      then list_difference l k
      else x :: list_difference l k
    end.
  Fixpoint list_intersection (l k : list A) : list A :=
    match l with
    | [] => []
    | x :: l =>
      if decide_rel () x k
      then x :: list_intersection l k
      else list_intersection l k
    end.
  Definition list_intersection_with (f : A  A  option A) :
    list A  list A  list A := fix go l k :=
    match l with
    | [] => []
    | x :: l => foldr (λ y,
        match f x y with None => id | Some z => (z ::) end) (go l k) k
    end.
End list_set.
316 317

(** * Basic tactics on lists *)
318 319 320
(** The tactic [discriminate_list_equality] discharges a goal if it contains
a list equality involving [(::)] and [(++)] of two lists that have a different
length as one of its hypotheses. *)
321 322
Tactic Notation "discriminate_list_equality" hyp(H) :=
  apply (f_equal length) in H;
323
  repeat (simpl in H || rewrite app_length in H); exfalso; lia.
324
Tactic Notation "discriminate_list_equality" :=
325 326 327
  match goal with
  | H : @eq (list _) _ _ |- _ => discriminate_list_equality H
  end.
328

329 330 331
(** The tactic [simplify_list_equality] simplifies hypotheses involving
equalities on lists using injectivity of [(::)] and [(++)]. Also, it simplifies
lookups in singleton lists. *)
332 333 334
Ltac simplify_list_equality :=
  repeat match goal with
  | _ => progress simplify_equality
335
  | H : _ ++ _ = _ ++ _ |- _ => first
336 337
    [ apply app_inj_tail in H; destruct H
    | apply app_inv_head in H | apply app_inv_tail in H ]
Robbert Krebbers's avatar
Robbert Krebbers committed
338
  | H : [?x] !! ?i = Some ?y |- _ =>
339 340 341
    destruct i; [change (Some x = Some y) in H | discriminate]
  end;
  try discriminate_list_equality.
342 343
Ltac simplify_list_equality' :=
  repeat (progress simpl in * || simplify_list_equality).
344

345 346
(** * General theorems *)
Section general_properties.
Robbert Krebbers's avatar
Robbert Krebbers committed
347
Context {A : Type}.
348 349
Implicit Types x y z : A.
Implicit Types l k : list A.
Robbert Krebbers's avatar
Robbert Krebbers committed
350

351 352 353
Global Instance: Injective2 (=) (=) (=) (@cons A).
Proof. by injection 1. Qed.
Global Instance:  k, Injective (=) (=) (k ++).
354
Proof. intros ???. apply app_inv_head. Qed.
355
Global Instance:  k, Injective (=) (=) (++ k).
356
Proof. intros ???. apply app_inv_tail. Qed.
357 358 359 360 361 362
Global Instance: Associative (=) (@app A).
Proof. intros ???. apply app_assoc. Qed.
Global Instance: LeftId (=) [] (@app A).
Proof. done. Qed.
Global Instance: RightId (=) [] (@app A).
Proof. intro. apply app_nil_r. Qed.
363

364 365 366 367 368 369 370 371 372 373
Lemma app_nil l1 l2 : l1 ++ l2 = []  l1 = []  l2 = [].
Proof. split. apply app_eq_nil. by intros [??]; subst. Qed.
Lemma app_singleton l1 l2 x :
  l1 ++ l2 = [x]  l1 = []  l2 = [x]  l1 = [x]  l2 = [].
Proof. split. apply app_eq_unit. by intros [[??]|[??]]; subst. Qed.

Lemma cons_middle x l1 l2 : l1 ++ x :: l2 = l1 ++ [x] ++ l2.
Proof. done. Qed.
Lemma app_inj l1 k1 l2 k2 :
  length l1 = length k1  l1 ++ l2 = k1 ++ k2  l1 = k1  l2 = k2.
Robbert Krebbers's avatar
Robbert Krebbers committed
374 375
Proof. revert k1. induction l1; intros [|??]; naive_solver. Qed.

376
Lemma list_eq l1 l2 : ( i, l1 !! i = l2 !! i)  l1 = l2.
377 378
Proof.
  revert l2. induction l1; intros [|??] H.
379
  * done.
380 381
  * discriminate (H 0).
  * discriminate (H 0).
382
  * f_equal; [by injection (H 0) |]. apply IHl1. intro. apply (H (S _)).
383
Qed.
384
Lemma list_eq_nil l : ( i, l !! i = None)  l = nil.
385
Proof. intros. by apply list_eq. Qed.
386

387
Global Instance list_eq_dec {dec :  x y, Decision (x = y)} :  l k,
388
  Decision (l = k) := list_eq_dec dec.
389 390
Definition list_singleton_dec l : { x | l = [x] } + { length l  1 }.
Proof. by refine match l with [x] => inleft (x_) | _ => inright _ end. Defined.
391

392
Lemma nil_or_length_pos l : l = []  length l  0.
393
Proof. destruct l; simpl; auto with lia. Qed.
394
Lemma nil_length l : length l = 0  l = [].
395 396
Proof. by destruct l. Qed.
Lemma lookup_nil i : @nil A !! i = None.
397
Proof. by destruct i. Qed.
398
Lemma lookup_tail l i : tail l !! i = l !! S i.
399
Proof. by destruct l. Qed.
400

401 402
Lemma lookup_lt_Some l i x : l !! i = Some x  i < length l.
Proof.
403
  revert i. induction l; intros [|?] ?; simplify_equality'; auto with arith.
404 405 406 407 408
Qed.
Lemma lookup_lt_is_Some_1 l i : is_Some (l !! i)  i < length l.
Proof. intros [??]; eauto using lookup_lt_Some. Qed.
Lemma lookup_lt_is_Some_2 l i : i < length l  is_Some (l !! i).
Proof.
409
  revert i. induction l; intros [|?] ?; simplify_equality'; eauto with lia.
410 411 412 413 414 415 416 417 418 419 420 421
Qed.
Lemma lookup_lt_is_Some l i : is_Some (l !! i)  i < length l.
Proof. split; auto using lookup_lt_is_Some_1, lookup_lt_is_Some_2. Qed.

Lemma lookup_ge_None l i : l !! i = None  length l  i.
Proof. rewrite eq_None_not_Some, lookup_lt_is_Some. lia. Qed.
Lemma lookup_ge_None_1 l i : l !! i = None  length l  i.
Proof. by rewrite lookup_ge_None. Qed.
Lemma lookup_ge_None_2 l i : length l  i  l !! i = None.
Proof. by rewrite lookup_ge_None. Qed.

Lemma list_eq_length l1 l2 :
Robbert Krebbers's avatar
Robbert Krebbers committed
422
  length l2 = length l1 
423
  ( i x y, l1 !! i = Some x  l2 !! i = Some y  x = y)  l1 = l2.
Robbert Krebbers's avatar
Robbert Krebbers committed
424
Proof.
425 426 427 428 429
  intros Hl ?. apply list_eq. intros i. destruct (l2 !! i) as [x|] eqn:Hx.
  * destruct (lookup_lt_is_Some_2 l1 i) as [y ?]; subst.
    + rewrite <-Hl. eauto using lookup_lt_Some.
    + naive_solver.
  * by rewrite lookup_ge_None, <-Hl, <-lookup_ge_None.
Robbert Krebbers's avatar
Robbert Krebbers committed
430 431
Qed.

432
Lemma lookup_app_l l1 l2 i : i < length l1  (l1 ++ l2) !! i = l1 !! i.
433
Proof. revert i. induction l1; intros [|?]; simpl; auto with lia. Qed.
434 435
Lemma lookup_app_l_Some l1 l2 i x : l1 !! i = Some x  (l1 ++ l2) !! i = Some x.
Proof. intros. rewrite lookup_app_l; eauto using lookup_lt_Some. Qed.
436

437
Lemma lookup_app_r l1 l2 i : (l1 ++ l2) !! (length l1 + i) = l2 !! i.
438 439 440 441
Proof. revert i. induction l1; intros [|i]; simplify_equality'; auto. Qed.
Lemma lookup_app_r_alt l1 l2 i j :
  j = length l1  (l1 ++ l2) !! (j + i) = l2 !! i.
Proof. intros ->. by apply lookup_app_r. Qed.
442 443
Lemma lookup_app_r_Some l1 l2 i x :
  l2 !! i = Some x  (l1 ++ l2) !! (length l1 + i) = Some x.
444
Proof. by rewrite lookup_app_r. Qed.
445 446 447 448
Lemma lookup_app_minus_r l1 l2 i :
  length l1  i  (l1 ++ l2) !! i = l2 !! (i - length l1).
Proof. intros. rewrite <-(lookup_app_r l1 l2). f_equal. lia. Qed.

449 450
Lemma lookup_app_inv l1 l2 i x :
  (l1 ++ l2) !! i = Some x  l1 !! i = Some x  l2 !! (i - length l1) = Some x.
451
Proof. revert i. induction l1; intros [|i] ?; simplify_equality'; auto. Qed.
452
Lemma list_lookup_middle l1 l2 x : (l1 ++ x :: l2) !! length l1 = Some x.
453
Proof. by induction l1; simpl. Qed.
454

455
Lemma alter_length f l i : length (alter f i l) = length l.
456
Proof. revert i. induction l; intros [|?]; simpl; auto with lia. Qed.
457
Lemma insert_length l i x : length (<[i:=x]>l) = length l.
458 459
Proof. apply alter_length. Qed.

460
Lemma list_lookup_alter f l i : alter f i l !! i = f <$> l !! i.
461
Proof. revert i. induction l. done. intros [|i]. done. apply (IHl i). Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
462
Lemma list_lookup_alter_ne f l i j : i  j  alter f i l !! j = l !! j.
463 464 465 466
Proof.
  revert i j. induction l; [done|].
  intros [|i] [|j] ?; try done. apply (IHl i). congruence.
Qed.
467
Lemma list_lookup_insert l i x : i < length l  <[i:=x]>l !! i = Some x.
468
Proof.
469
  intros Hi. unfold insert, list_insert. rewrite list_lookup_alter.
470
  by destruct (lookup_lt_is_Some_2 l i); simplify_option_equality.
471
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
472
Lemma list_lookup_insert_ne l i j x : i  j  <[i:=x]>l !! j = l !! j.
473 474
Proof. apply list_lookup_alter_ne. Qed.

475 476
Lemma list_lookup_other l i x :
  length l  1  l !! i = Some x   j y, j  i  l !! j = Some y.
Robbert Krebbers's avatar
Robbert Krebbers committed
477
Proof.
478
  intros. destruct i, l as [|x0 [|x1 l]]; simplify_equality'.
Robbert Krebbers's avatar
Robbert Krebbers committed
479 480 481 482
  * by exists 1 x1.
  * by exists 0 x0.
Qed.

483 484
Lemma alter_app_l f l1 l2 i :
  i < length l1  alter f i (l1 ++ l2) = alter f i l1 ++ l2.
485
Proof.
486
  revert i. induction l1; intros [|?] ?; simpl in *; f_equal; auto with lia.
487
Qed.
488
Lemma alter_app_r f l1 l2 i :
489
  alter f (length l1 + i) (l1 ++ l2) = l1 ++ alter f i l2.
490 491 492
Proof. revert i. induction l1; intros [|?]; simpl in *; f_equal; auto. Qed.
Lemma alter_app_r_alt f l1 l2 i :
  length l1  i  alter f i (l1 ++ l2) = l1 ++ alter f (i - length l1) l2.
493 494 495 496
Proof.
  intros. assert (i = length l1 + (i - length l1)) as Hi by lia.
  rewrite Hi at 1. by apply alter_app_r.
Qed.
497 498 499 500 501 502 503 504 505 506 507 508
Lemma list_alter_ext f g l i :
  ( x, l !! i = Some x  f x = g x)  alter f i l = alter g i l.
Proof. revert i. induction l; intros [|?] ?; simpl; f_equal; auto. Qed.
Lemma list_alter_compose f g l i :
  alter (f  g) i l = alter f i (alter g i l).
Proof. revert i. induction l; intros [|?]; simpl; f_equal; auto. Qed.
Lemma list_alter_commute f g l i j :
  i  j  alter f i (alter g j l) = alter g j (alter f i l).
Proof.
  revert i j.
  induction l; intros [|?] [|?]; simpl; auto with f_equal congruence.
Qed.
509

510 511
Lemma insert_app_l l1 l2 i x :
  i < length l1  <[i:=x]>(l1 ++ l2) = <[i:=x]>l1 ++ l2.
512
Proof. apply alter_app_l. Qed.
513
Lemma insert_app_r l1 l2 i x : <[length l1+i:=x]>(l1 ++ l2) = l1 ++ <[i:=x]>l2.
514
Proof. apply alter_app_r. Qed.
515 516
Lemma insert_app_r_alt l1 l2 i x :
  length l1  i  <[i:=x]>(l1 ++ l2) = l1 ++ <[i - length l1:=x]>l2.
517 518
Proof. apply alter_app_r_alt. Qed.

519
Lemma delete_middle l1 l2 x : delete (length l1) (l1 ++ x :: l2) = l1 ++ l2.
520 521
Proof. induction l1; simpl; f_equal; auto. Qed.

522
(** ** Properties of the [elem_of] predicate *)
523
Lemma not_elem_of_nil x : x  [].
524
Proof. by inversion 1. Qed.
525
Lemma elem_of_nil x : x  []  False.
526
Proof. intuition. by destruct (not_elem_of_nil x). Qed.
527
Lemma elem_of_nil_inv l : ( x, x  l)  l = [].
528
Proof. destruct l. done. by edestruct 1; constructor. Qed.
529
Lemma elem_of_cons l x y : x  y :: l  x = y  x  l.
530 531
Proof.
  split.
532 533
  * inversion 1; subst. by left. by right.
  * intros [?|?]; subst. by left. by right.
534
Qed.
535
Lemma not_elem_of_cons l x y : x  y :: l  x  y  x  l.
Robbert Krebbers's avatar
Robbert Krebbers committed
536
Proof. rewrite elem_of_cons. tauto. Qed.
537
Lemma elem_of_app l1 l2 x : x  l1 ++ l2  x  l1  x  l2.
538
Proof.
539
  induction l1.
540
  * split; [by right|]. intros [Hx|]; [|done]. by destruct (elem_of_nil x).
541
  * simpl. rewrite !elem_of_cons, IHl1. tauto.
542
Qed.
543
Lemma not_elem_of_app l1 l2 x : x  l1 ++ l2  x  l1  x  l2.
Robbert Krebbers's avatar
Robbert Krebbers committed
544
Proof. rewrite elem_of_app. tauto. Qed.
545
Lemma elem_of_list_singleton x y : x  [y]  x = y.
546
Proof. rewrite elem_of_cons, elem_of_nil. tauto. Qed.
547

Robbert Krebbers's avatar
Robbert Krebbers committed
548
Global Instance elem_of_list_permutation_proper x : Proper (() ==> iff) (x ).
549
Proof. induction 1; rewrite ?elem_of_nil, ?elem_of_cons; intuition. Qed.
550

551
Lemma elem_of_list_split l x : x  l   l1 l2, l = l1 ++ x :: l2.
552 553 554 555 556
Proof.
  induction 1 as [x l|x y l ? [l1 [l2 ?]]].
  * by eexists [], l.
  * subst. by exists (y :: l1) l2.
Qed.
557

558
Lemma elem_of_list_lookup_1 l x : x  l   i, l !! i = Some x.
559
Proof.
560 561
  induction 1 as [|???? IH]; [by exists 0 |].
  destruct IH as [i ?]; auto. by exists (S i).
562
Qed.
563
Lemma elem_of_list_lookup_2 l i x : l !! i = Some x  x  l.
564
Proof.
565
  revert i. induction l; intros [|i] ?; simplify_equality'; constructor; eauto.
566
Qed.
567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625
Lemma elem_of_list_lookup l x : x  l   i, l !! i = Some x.
Proof. firstorder eauto using elem_of_list_lookup_1, elem_of_list_lookup_2. Qed.

(** ** Set operations on lists *)
Section list_set.
  Context {dec :  x y, Decision (x = y)}.

  Lemma elem_of_list_difference l k x :
    x  list_difference l k  x  l  x  k.
  Proof.
    split; induction l; simpl; try case_decide;
      rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence.
  Qed.
  Lemma list_difference_nodup l k : NoDup l  NoDup (list_difference l k).
  Proof.
    induction 1; simpl; try case_decide.
    * constructor.
    * done.
    * constructor. rewrite elem_of_list_difference; intuition. done.
  Qed.

  Lemma elem_of_list_intersection l k x :
    x  list_intersection l k  x  l  x  k.
  Proof.
    split; induction l; simpl; repeat case_decide;
      rewrite ?elem_of_nil, ?elem_of_cons; intuition congruence.
  Qed.
  Lemma list_intersection_nodup l k : NoDup l  NoDup (list_intersection l k).
  Proof.
    induction 1; simpl; try case_decide.
    * constructor.
    * constructor. rewrite elem_of_list_intersection; intuition. done.
    * done.
  Qed.

  Lemma elem_of_list_intersection_with f l k x :
    x  list_intersection_with f l k   x1 x2,
      x1  l  x2  k  f x1 x2 = Some x.
  Proof.
    split.
    * induction l as [|x1 l IH]; simpl.
      + by rewrite elem_of_nil.
      + intros Hx. setoid_rewrite elem_of_cons.
        cut (( x2, x2  k  f x1 x2 = Some x)
           x  list_intersection_with f l k); [naive_solver|].
        clear IH. revert Hx. generalize (list_intersection_with f l k).
        induction k; simpl; [by auto|].
        case_match; setoid_rewrite elem_of_cons; naive_solver.
    * intros (x1 & x2 & Hx1 & Hx2 & Hx).
      induction Hx1 as [x1 | x1 ? l ? IH]; simpl.
      + generalize (list_intersection_with f l k).
        induction Hx2; simpl; [by rewrite Hx; left |].
        case_match; simpl; try setoid_rewrite elem_of_cons; auto.
      + generalize (IH Hx). clear Hx IH Hx2.
        generalize (list_intersection_with f l k).
        induction k; simpl; intros; [done |].
        case_match; simpl; rewrite ?elem_of_cons; auto.
  Qed.
End list_set.
Robbert Krebbers's avatar
Robbert Krebbers committed
626

627
(** ** Properties of the [NoDup] predicate *)
628 629
Lemma NoDup_nil : NoDup (@nil A)  True.
Proof. split; constructor. Qed.
630
Lemma NoDup_cons x l : NoDup (x :: l)  x  l  NoDup l.
631
Proof. split. by inversion 1. intros [??]. by constructor. Qed.
632
Lemma NoDup_cons_11 x l : NoDup (x :: l)  x  l.
633
Proof. rewrite NoDup_cons. by intros [??]. Qed.
634
Lemma NoDup_cons_12 x l : NoDup (x :: l)  NoDup l.
635
Proof. rewrite NoDup_cons. by intros [??]. Qed.
636
Lemma NoDup_singleton x : NoDup [x].
637 638
Proof. constructor. apply not_elem_of_nil. constructor. Qed.

639
Lemma NoDup_app l k : NoDup (l ++ k)  NoDup l  ( x, x  l  x  k)  NoDup k.
Robbert Krebbers's avatar
Robbert Krebbers committed
640
Proof.
641
  induction l; simpl.
642
  * rewrite NoDup_nil. setoid_rewrite elem_of_nil. naive_solver.
643
  * rewrite !NoDup_cons.
Robbert Krebbers's avatar
Robbert Krebbers committed
644
    setoid_rewrite elem_of_cons. setoid_rewrite elem_of_app. naive_solver.
Robbert Krebbers's avatar
Robbert Krebbers committed
645
Qed.
646
Global Instance NoDup_proper: Proper (() ==> iff) (@NoDup A).
647 648 649 650 651 652 653
Proof.
  induction 1 as [|x l k Hlk IH | |].
  * by rewrite !NoDup_nil.
  * by rewrite !NoDup_cons, IH, Hlk.
  * rewrite !NoDup_cons, !elem_of_cons. intuition.
  * intuition.
Qed.
654 655 656 657 658 659 660 661
Lemma NoDup_lookup l i j x : NoDup l  l !! i = Some x  l !! j = Some x  i = j.
Proof.
  intros Hl. revert i j. induction Hl as [|x' l Hx Hl IH].
  { intros; simplify_equality. }
  intros [|i] [|j] ??; simplify_equality'; eauto with f_equal;
    exfalso; eauto using elem_of_list_lookup_2.
Qed.
Lemma NoDup_alt l : NoDup l   i j x, l !! i = Some x  l !! j = Some x  i = j.
662
Proof.
663 664 665 666 667
  split; eauto using NoDup_lookup.
  induction l as [|x l IH]; intros Hl; constructor.
  * rewrite elem_of_list_lookup. intros [i ?].
    by feed pose proof (Hl (S i) 0 x); auto.
  * apply IH. intros i j x' ??. by apply (injective S), (Hl (S i) (S j) x').
668
Qed.
Robbert Krebbers's avatar
Robbert Krebbers committed
669

670 671
Section no_dup_dec.
  Context `{! x y, Decision (x = y)}.
672

673 674 675 676
  Global Instance NoDup_dec:  l, Decision (NoDup l) :=
    fix NoDup_dec l :=
    match l return Decision (NoDup l) with
    | [] => left NoDup_nil_2
677
    | x :: l =>
678 679 680 681 682 683 684 685
      match decide_rel () x l with
      | left Hin => right (λ H, NoDup_cons_11 _ _ H Hin)
      | right Hin =>
        match NoDup_dec l with
        | left H => left (NoDup_cons_2 _ _ Hin H)
        | right H => right (H  NoDup_cons_12 _ _)
        end
      end
686
    end.
687

688
  Lemma elem_of_remove_dups l x : x  remove_dups l  x  l.
689 690 691 692 693 694 695 696 697
  Proof.
    split; induction l; simpl; repeat case_decide;
      rewrite ?elem_of_cons; intuition (simplify_equality; auto).
  Qed.
  Lemma remove_dups_nodup l : NoDup (remove_dups l).
  Proof.
    induction l; simpl; repeat case_decide; try constructor; auto.
    by rewrite elem_of_remove_dups.
  Qed.
698
End no_dup_dec.
699

700
(** ** Properties of the [filter] function *)
701 702 703 704 705 706 707 708 709 710 711 712 713 714
Section filter.
  Context (P : A  Prop) `{ x, Decision (P x)}.

  Lemma elem_of_list_filter l x : x  filter P l  P x  x  l.
  Proof.
    unfold filter. induction l; simpl; repeat case_decide;
       rewrite ?elem_of_nil, ?elem_of_cons; naive_solver.
  Qed.
  Lemma filter_nodup l : NoDup l  NoDup (filter P l).
  Proof.
    unfold filter. induction 1; simpl; repeat case_decide;
      rewrite ?NoDup_nil, ?NoDup_cons, ?elem_of_list_filter; tauto.
  Qed.
End filter.
Robbert Krebbers's avatar
Robbert Krebbers committed
715

716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742
(** ** Properties of the [find] function *)
Section find.
  Context (P : A  Prop) `{ x, Decision (P x)}.

  Lemma list_find_Some l i : list_find P l = Some i   x, l !! i = Some x  P x.
  Proof.
    revert i. induction l; simpl; repeat case_decide;
      eauto with simplify_option_equality.
  Qed.
  Lemma list_find_elem_of l x : x  l  P x   i, list_find P l = Some i.
  Proof.
    induction 1; simpl; repeat case_decide;
      naive_solver (by eauto with simplify_option_equality).
  Qed.
End find.

Section find_eq.
  Context `{ x y, Decision (x = y)}.

  Lemma list_find_eq_Some l i x : list_find (x =) l = Some i  l !! i = Some x.
  Proof.
    intros. destruct (list_find_Some (x =) l i) as (?&?&?); auto with congruence.
  Qed.
  Lemma list_find_eq_elem_of l x : x  l   i, list_find (x=) l = Some i.
  Proof. eauto using list_find_elem_of. Qed.
End find_eq.

743
(** ** Properties of the [reverse] function *)
744 745
Lemma reverse_nil : reverse [] = @nil A.
Proof. done. Qed.
746
Lemma reverse_singleton x : reverse [x] = [x].
747
Proof. done. Qed.
748
Lemma reverse_cons l x : reverse (x :: l) = reverse l ++ [x].
749
Proof. unfold reverse. by rewrite <-!rev_alt. Qed.
750
Lemma reverse_snoc l x : reverse (l ++ [x]) = x :: reverse l.
751
Proof. unfold reverse. by rewrite <-!rev_alt, rev_unit. Qed.
752
Lemma reverse_app l1 l2 : reverse (l1 ++ l2) = reverse l2 ++ reverse l1.
753
Proof. unfold reverse. rewrite <-!rev_alt. apply rev_app_distr. Qed.
754
Lemma reverse_length l : length (reverse l) = length l.
755
Proof. unfold reverse. rewrite <-!rev_alt. apply rev_length. Qed.
756
Lemma reverse_involutive l : reverse (reverse l) = l.
757
Proof. unfold reverse. rewrite <-!rev_alt. apply rev_involutive. Qed.
758 759 760 761 762 763 764 765 766 767 768 769 770 771 772
Lemma elem_of_reverse_2 x l : x  l  x  reverse l.
Proof.
  induction 1; rewrite reverse_cons, elem_of_app,
    ?elem_of_list_singleton; intuition.
Qed.
Lemma elem_of_reverse x l : x  reverse l  x  l.
Proof.
  split; auto using elem_of_reverse_2.
  intros. rewrite <-(reverse_involutive l). by apply elem_of_reverse_2.
Qed.
Global Instance: Injective (=) (=) (@reverse A).
Proof.
  intros l1 l2 Hl.
  by rewrite <-(reverse_involutive l1), <-(reverse_involutive l2), Hl.
Qed.
773

774
(** ** Properties of the [take] function *)
775 776 777
Definition take_drop := @firstn_skipn A.

Lemma take_nil n : take n (@nil A) = [].
Robbert Krebbers's avatar
Robbert Krebbers committed
778
Proof. by destruct n. Qed.
779
Lemma take_app l k : take (length l) (l ++ k) = l.
Robbert Krebbers's avatar
Robbert Krebbers committed
780
Proof. induction l; simpl; f_equal; auto. Qed.
781
Lemma take_app_alt l k n : n = length l  take n (l ++ k) = l.
Robbert Krebbers's avatar
Robbert Krebbers committed
782
Proof. intros Hn. by rewrite Hn, take_app. Qed.
783
Lemma take_app_le l k n : n  length l  take n (l ++ k) = take n l.
Robbert Krebbers's avatar
Robbert Krebbers committed
784
Proof.
785
  revert n. induction l; intros [|?] ?; simpl in *; f_equal; auto with lia.
Robbert Krebbers's avatar
Robbert Krebbers committed
786
Qed.
787 788
Lemma take_app_ge l k n :
  length l  n  take n (l ++ k) = l ++ take (n - length l) k.
Robbert Krebbers's avatar
Robbert Krebbers committed
789
Proof.
790
  revert n. induction l; intros [|?] ?; simpl in *; f_equal; auto with lia.
Robbert Krebbers's avatar
Robbert Krebbers committed
791
Qed.
792
Lemma take_ge l n : length l  n  take n l = l.
Robbert Krebbers's avatar
Robbert Krebbers committed
793
Proof.
794
  revert n. induction l; intros [|?] ?; simpl in *; f_equal; auto with lia.
Robbert Krebbers's avatar
Robbert Krebbers committed
795 796
Qed.

797
Lemma take_take l n m : take n (take m l) = take (min n m) l.
Robbert Krebbers's avatar
Robbert Krebbers committed
798
Proof. revert n m. induction l; intros [|?] [|?]; simpl; f_equal; auto. Qed.