Section HeapReflection.
(* The algorithm works as follow: - if the heap is h1 :+ h2 then recurse over both and concatenate the results - if the heap is the empty heap, return [] - if the heap is p :-> v then add p to the context, and return [Pts x v], where x is the deBruijn index for p in the context - if the heap is whatever else, add the heap to the context and return [Var n], where n is the deBruijn index for the heap in the context *)
(* a tagging structure to control the flow of computation *)
Structure tagged_heap := Tag {untag :> heap}.
(* in reversed order; first test for unions, then empty, pts and vars *)
Definition var_tag := Tag.
Definition pts_tag := var_tag.
Definition empty_tag := pts_tag.
Canonical Structure union_tag hc := empty_tag hc.
Definition invariant i j t h := [/\ interp j t = h, subctx i j & valid j t].
(* Main structure i : input context j : output context t : syntactification of heap_of using context j *)
Structure ast (i j : ctx) (t : synheap) :=
Ast {heap_of :> tagged_heap;
_ : invariant i j t heap_of}.
Arguments Ast : clear implicits.
(* pass output context of f1 as input of f2 *)
Canonical Structure
union_struct i j k t1 t2 (f1 : ast i j t1) (f2 : ast j k t2) :=
Ast i k _ (union_tag (f1 :+ f2)) (union_pf f1 f2).
Canonical Structure
pts_struct A hs xs1 xs2 x (d : A)
(xs : xfind xs1 xs2 x) :=
Ast (Context hs xs1) (Context hs xs2)
[:: Pts x (dyn d)]
(pts_tag (xuntag xs :-> d))
(pts_pf hs _ xs).
Canonical Structure var_struct hs1 hs2 xs n (f : xfind hs1 hs2 n) :=
Ast (Context hs1 xs) (Context hs2 xs) _
(var_tag (xuntag f))
(var_pf xs f).
End HeapReflection.

(* The main lemma *)
Theorem cancelR j k t1 t2 (f1 : ast empc j t1) (f2 : ast j k t2) :
def (untag (heap_of f1)) ->
untag (heap_of f1) = untag (heap_of f2) ->
eval k (cancel k t1 t2).