(* Copyright (C) 2012  G. Gonthier, B. Ziliani, A. Nanevski, D. Dreyer  This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.  This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.  You should have received a copy of the GNU General Public License along with this program.  If not, see <http://www.gnu.org/licenses/>. *)
From mathcomp
From LemmaOverloading
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
(**************************************************************************)
(*                  Syntactic cancelation of heaps                        *)
(**************************************************************************)
(* Differences w.r.t. the paper:  In the paper we described the cancellation algorithm as producing a proposition. Instead, it will produce a sequence of "facts" which are later on evaluated into a proposition. We did this in order to further simplify the proposition. Each fact is of the form t1 = t2, where t1 and t2 are heaps, pointers, or values.  Another simplification we made in the paper is that the values contained in a heap are actually instances of a generic type 'dynamic'. This type is defined in the file heaps.v, and is just a structure containing a value and its type. So, instead of equating values, we are equating dynamics, therefore we need some extra step to prove the values are equal (see the examples at the bottom of the file). This can be avoided with extra canonical structures machinery. *)
(***************************)
(* interpretation contexts *)
(***************************)
Structure ctx := Context {heap_ctx : seq heap; ptr_ctx : seq ptr}.
Definition empc := Context [::] [::].
Definition subctx i j :=
prefix (heap_ctx i) (heap_ctx j) /\ prefix (ptr_ctx i) (ptr_ctx j).
(**************************************************************************)
(*                            Syntactic heaps                             *)
(* Pointers and heap variables are syntactified as indices in the context *)
(* Disjoint union is syntactified as concatenation of lists               *)
(**************************************************************************)
Inductive elem := Pts of nat & dynamic | Var of nat.
Definition synheap := seq elem.
(*****************************************************************************)
(* Validity of indices:                                                      *)
(*   valid i t  iif all the indices in t are in bounds of the contexts lists *)
(*****************************************************************************)
Fixpoint valid_ptrs i t :=
match t with
Pts sx _ :: s => (sx < size (ptr_ctx i)) && valid_ptrs i s
| Var _ :: s => valid_ptrs i s
| _ => true
end.
Fixpoint valid_heaps i t :=
match t with
Pts _ _ :: s => valid_heaps i s
| Var v :: s => (v < size (heap_ctx i)) && valid_heaps i s
| _ => true
end.
Definition valid i t := valid_ptrs i t && valid_heaps i t.
(*************************************)
(* interpretation of syntactic heaps *)
(*************************************)
(* lookup functions for heaps and pointers *)
Definition hlook := [fun i => onth (heap_ctx i)].
Definition plook := [fun i => onth (ptr_ctx i)].
(* notation for lookups with default *)
Notation plook' i x := (odflt null (plook i x)).
(* interpretation function for elements *)
Definition einterp i e :=
match e with
Pts x d =>
if plook i x is Some x'
then x' :-> Dyn.val d
else Undef
| Var h => if hlook i h is Some h' then h' else Undef
end.
(* main interpretation function *)
Fixpoint interp i t :=
if t is e :: t' then
if t' is [::] then einterp i e else einterp i e :+ interp i t'
else empty.

Lemma interp_cons i e t : interp i (e :: t) = einterp i e :+ interp i t.