Set Implicit Arguments.
Opaque plus. (* avoid pesky reductions *)
(* ---------------------------------------------------------------------------- *)
(* Environments map variables to data. *)
(* Environments are homogeneous -- there is only one kind of variables -- and non-dependent -- variables do not occur within data. *)
(* What should be the type of an environment? Multiple answers come to mind, such as [list A], [nat -> option A], [list (option A)], etc. The choice of a definition is guided by the desire that [lookup] and [insert] be total functions that satisfy a number of natural laws. In particular, if [insert] is a total function, then we cannot expect the domain of an environment to be contiguous. This rules out [list A]. Representing an environment by its lookup function, of type [nat -> option A], works, but does not allow defining [fold] over environments. In the end, representing an environment by a finite list of possibly-null entries seems to be a reasonable choice. *)
Definition env A :=
list (option A).
(* What notion of equality over environments do we need? Extensional equality of the [lookup] functions seems to be the most natural notion. The predicate [agree], defined below, is a bounded version of this notion. Perhaps by chance, the basic laws that relate [lookup], [insert], and [map] are valid with respect to Leibniz equality, so we do not define extensional equality. *)
(* ---------------------------------------------------------------------------- *)
(* Operations on environments. *)
(* The empty environment is undefined everywhere. *)
Definition empty A : env A :=
nil.
(* Environment lookup. *)
Fixpoint lookup A (x : nat) (e : env A) : option A :=
match e, x with
| nil, _ =>
None
| entry :: _, 0 =>
entry
| _ :: e, S x =>
lookup x e
end.
(* [insert x a e] inserts a new variable [x], associated with data [a], in the environment [e]. The pre-existing environment entries at index [x] and above are shifted up. Thus, [insert x] is closely analogous to [shift x] for terms. *)
(* [insert] inserts a non-null entry in the environment. We define it in terms of [raw_insert], which can also be used to insert a null entry. [raw_insert] is useful because it allows generating every environment (thus, it can be used in the formulation of an induction principle). *)
Fixpoint raw_insert A (x : nat) (o : option A) (e : env A) : env A :=
match x, e with
| 0, _ =>
o :: e
| S x, entry :: e =>
entry :: raw_insert x o e
| S x, nil =>
None :: raw_insert x o e
end.
Notation insert x a e :=
(raw_insert x (Some a) e).
(* [map f e] is the environment obtained by applying [f] to every datum in the environment [e]. *)
Fixpoint map A B (f : A -> B) (e : env A) :=
match e with
| nil =>
nil
| None :: e =>
None :: map f e
| Some a :: e =>
Some (f a) :: map f e
end.
(* [fold f e accu] performs an iteration over all entries in the environment. Older entries are visited first: in other words, the initial accumulator should make sense at the toplevel, outside of the environment, and is pushed successively into every binding, so as to yield a final accumulator that makes sense inside this environment. *)
Fixpoint fold A B (f : option A -> B -> B) (e : env A) (accu : B) : B :=
match e with
| nil =>
accu
| o :: e =>
f o (fold f e accu)
end.
(* ---------------------------------------------------------------------------- *)
(* Basic arithmetic simplifications. *)
Ltac one_plus_x_minus_one :=
repeat rewrite one_plus_x_minus_one_left in *;
repeat rewrite one_plus_x_minus_one_right in * by omega.
(* I tried [autorewrite with ... using omega]; it does not work. *)
(* ---------------------------------------------------------------------------- *)
(* Trivial facts. *)
(* ---------------------------------------------------------------------------- *)
(* Interaction between [lookup] and [empty]. *)
(* ---------------------------------------------------------------------------- *)
(* Interaction between [lookup] and [insert]. *)
(* Hence, [lookup x (insert y a e) = Some a]. *)
(* Hence, [lookup x (insert y a e) = lookup x e]. *)
(* Hence, [lookup x (insert y a e) = lookup (x - 1) e]. *)
(* Hence, [lookup (shift y x) (insert y a e) = lookup x e]. *)
Ltac lookup_insert :=
first [
rewrite lookup_insert_bingo by omega
| rewrite lookup_insert_old by omega; one_plus_x_minus_one
| rewrite lookup_insert_recent by omega
| rewrite lookup_shift_insert
].
Ltac lookup_insert_all :=
first [
rewrite lookup_insert_bingo in * by omega;
try match goal with h: Some _ = Some _ |- _ => injection h; intro; subst; clear h end
| rewrite lookup_insert_old in * by omega; one_plus_x_minus_one
| rewrite lookup_insert_recent in * by omega
| rewrite lookup_shift_insert in *
].
Hint Extern 1 (lookup _ (raw_insert _ _ _) = _) =>
lookup_insert
: lookup_insert.
Hint Extern 1 (lookup _ _ = _) =>
lookup_insert_all
: lookup_insert.
(* ---------------------------------------------------------------------------- *)
(* Interaction between [map] and [empty]. *)
(* ---------------------------------------------------------------------------- *)
(* Interaction between [lookup] and [map]. *)
(* ---------------------------------------------------------------------------- *)
(* [insert] commutes with itself, just like [lift] commutes with itself. *)
(* Even when it is not known which of [k] and [s] is greater, [insert] commutes with itself. The formula is slightly horrid, but can be very useful. *)
(* Attempting to rewrite in both directions may seem redundant, because of the symmetry of the law [insert_insert]. It is not: because [omega] fails in the presence of meta-variables, rewriting in one direction may be possible while the other direction fails. *)
Ltac insert_insert :=
first [
rewrite    insert_insert; [ reflexivity | omega ]
| rewrite <- insert_insert; [ reflexivity | omega ]
].
Hint Extern 1 (raw_insert _ _ _ = _) =>
insert_insert
: insert_insert.
Hint Extern 1 (_ = raw_insert _ _ _) =>
insert_insert
: insert_insert.
(* The result of an insertion cannot be nil. *)
(* Two lemmas about equations of the form [insert x a1 e1 = insert x a2 e2]. Note that we have [a1 = a2], but not [e1 = e2], due to padding. *)
(* This is a really crazy diamond lemma that says, roughly, if the equation [insert x1 a1 e1 = insert x2 a2 e2] holds, then [e1] and [e2] can be constructed out of a common environment [e]. We would like to conclude [e1 = insert x2 a2 e /\ e2 = insert x1 a1 e], but this is false, because one of the indices is off-by-one in one way or the other. We need to adjust, and the arithmetic is a bit painful. *)
(* ---------------------------------------------------------------------------- *)
(* Interaction between [map] and [insert]. *)
(* The following variant is easier to use for [eauto]. *)
Ltac map_insert :=
first [
rewrite map_insert; reflexivity
| rewrite <- map_insert; reflexivity
].
Hint Extern 1 (map _ (insert _ _ _) = insert _ _ (map _ _)) =>
map_insert
: map_insert.
Hint Extern 1 (insert _ _ (map _ _) = map _ (insert _ _ _)) =>
map_insert
: map_insert.
(* ---------------------------------------------------------------------------- *)
(* [map] composes with itself. *)
(* ---------------------------------------------------------------------------- *)
(* Properties of [fold]. *)
(* Interaction between [fold] and [empty]. *)
(* Interaction between [fold] and [insert]. *)
(* An induction principle. In order to prove that a property [P] holds of [fold f e accu], it suffices to hold that it holds of the initial accumulator and that it is preserved by one iteration. The statement is expressed in terms of [empty] and [raw_insert], so the fact that environments are implemented as lists is not exposed. *)

Lemma fold_invariant:
forall A B (P : env A -> B -> Prop) f accu,
P (@empty _) accu ->
(forall o e accu, P e accu -> P (raw_insert 0 o e) (f o accu)) ->
forall e,
P e (fold f e accu).