(* returns the proposition generated by a fact *)
Definition eval_fact i f :=
match f with
| eqH h1 h2 => interp i h1 = interp i h2
| eqD d1 d2 => d1 = d2
| eqX x1 x2 => plook i x1 = plook i x2
end.
(* returns the logic concatenation of all the facts in the list *)
Fixpoint eval i s :=
match s with
| [:: f] => eval_fact i f
| (f :: fs) => eval_fact i f /\ eval i fs
| [::] => True
end.
(* functions to collect pointers and heap variables indices out of a synheap *)
Fixpoint ptrs t : seq nat :=
if t is e :: t' then
if e is Pts x _ then x :: (ptrs t')
else ptrs t'
else [::].
Fixpoint vars t : seq nat :=
if t is e :: t' then
if e is Var h then h :: (vars t')
else vars t'
else [::].
Definition ptreq (x : nat) e := if e is Pts y _ then x == y else false.
Definition vareq (h : nat) e := if e is Var k then h == k else false.
Fixpoint pread x t :=
match t with
Pts y d :: s => if x == y then some d else pread x s
| e :: s => pread x s
| _ => None
end.
Notation pread' x t := (odflt (dyn tt) (pread x t)).
Definition pfree x t := filter (predC (ptreq x)) t.
Definition hfree h t := filter (predC (vareq h)) t.
(* Main function to perform the cancelation of heaps. One difference to point out from the description in the paper, appart from the fact that it is returning a list of facts, is that in the base case we consider the special case x1 :-> v1 = x2 :-> v2 -> x1 = x2 /\ v1 = v2  *)
Fixpoint cancel' (i : ctx) (t1 t2 r : synheap) (f : seq fact) : seq fact :=
match t1 with
| [::] => match r, t2 with
| [::], [::] => f
| [:: Pts x d], [:: Pts x' d'] =>
[:: eqX x x', eqD d d' & f]
| _ , _ => [:: eqH r t2 & f]
end
| Pts x d :: t1' =>
if x \in ptrs t2
then cancel' i t1' (pfree x t2) r [:: eqD d (pread' x t2) & f]
else cancel' i t1' t2 [:: Pts x d & r] f
| Var h :: t1' =>
if h \in vars t2 then cancel' i t1' (hfree h t2) r f
else cancel' i t1' t2 [:: Var h & r] f
end.
Definition cancel i t1 t2 := cancel' i t1 t2 [::] [::].
(* several auxiliary lemmas about the definitions given above *)

(* Specifications: *)
Lemma eval_cons i f s : eval i (f :: s) <-> eval_fact i f /\ eval i s.
Lemma eval_rcons i f s : eval i (rcons s f) <-> eval i s /\ eval_fact i f.
Lemma var_has h t : has (vareq h) t = (h \in vars t).
Lemma pfree_subdom i x t :
def (interp i t) -> subdom (interp i (pfree x t)) (interp i t).
Lemma pfree_def i x t: def (interp i t) -> def (interp i (pfree x t)).
Lemma vars_hfree (h1 h2 : nat) t :
has (vareq h1) (hfree h2 t) = (h1 != h2) && (has (vareq h1) t).
Lemma hfree_subdom i h t :
def (interp i t) ->
{subset dom (interp i (hfree h t)) <= dom (interp i t)}.
Lemma hfree_subdom' i h t :
def (interp i t) ->
subdom (interp i (hfree h t)) (interp i t).
Lemma hfree_def i h t : def (interp i t) -> def (interp i (hfree h t)).
Lemma countN_varfree i v t :
count (pred1 v) (vars t) > 1 -> def (interp i t) ->
hlook i v = Some empty.
Lemma empty_hfree i v t :
hlook i v = Some empty -> interp i (hfree v t) = interp i t.