(* 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
From mathcomp
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
(*************)
(* Locations *)
(*************)
Inductive ptr := ptr_nat of nat.
Definition null := ptr_nat 0.
Definition nat_ptr (x : ptr) := let: ptr_nat y := x in y.
Definition eq_ptr (x y : ptr) :=
match x, y with ptr_nat m, ptr_nat n => m == n end.
Definition ltn_ptr (x y : ptr) :=
match x, y with ptr_nat m, ptr_nat n => m < n end.
End NullLemmas.
(****************)
(* main methods *)
(****************)
Definition def h := if h is Def _ _ then true else false.
Definition empty := @Def (finmap.nil _ _) is_true_true.
Definition upd h x d := nosimpl
(if h is Def hs ns then
if decP (@idP (x != null)) is left pf then
Def (@upd_nullP _ _ d pf ns)
else Undef
else Undef).
Definition dom h : pred ptr := nosimpl
(if h is Def f _ then mem (supp f) else pred0).
Definition free x h : heap :=
(if h is Def hs ns then Def (free_nullP x ns) else Undef).
Definition look (x : ptr) h :=
(if h is Def hs _ then
if fnd x hs is Some d then d else dyn tt
else dyn tt).
Definition union2 h1 h2 := nosimpl
(if (h1, h2) is (Def hs1 ns1, Def hs2 ns2) then
if disj hs1 hs2 then
Def (@un_nullP _ _ ns1 ns2)
else Undef
else Undef).
Definition empb h :=
if h is Def hs _ then supp hs == [::] else false.
Definition fresh h :=
(if h is Def hs _ then last null (supp hs) else null) .+ 1.
Definition subdom h1 h2 :=
if (h1, h2) is (Def hs1 _, Def hs2 _) then
all (fun x => x \in supp hs2) (supp hs1)
else false.
Definition subheap h1 h2 :=
subdom h1 h2 /\ forall x, x \in dom h1 -> look x h1 = look x h2.
(* Definition subheap h1 h2 p :=  *)
(*   if (h1, h2) is (Def hs1 _, Def hs2 _) then  *)
(*     all (fun x => p (look x h1) (look x h2)) (supp hs1) *)
(*   else false. *)
Definition subtract h1 h2 :=
if h1 is (Def hs1 _) then
foldl (fun h x => free x h) h2 (supp hs1)
else Undef.
Definition pick h :=
if h is Def hs _ then head null (supp hs) else null.
Definition pts A (x : ptr) (v : A) := upd empty x (dyn v).
Notation "h1 :+ h2" := (union2 h1 h2) (at level 43, left associativity).
Notation "h2 :- h1" := (subtract h1 h2) (at level 43, left associativity).
Notation "x :-> v" := (pts x v) (at level 30).
(***********************)
(* monoidal properties *)
(***********************)
(*******)
(* def *)
(*******)
(********)
(* free *)
(********)
(* some transformation lemmas *)
(*********)
(* fresh *)
(*********)
(**********)
(* subdom *)
(**********)
Hint Resolve subdom_emp subdomPE : core.
(***********)
(* subheap *)
(***********)

Lemma subheapUnr h1 h2 : def (h1 :+ h2) -> subheap h2 (h1 :+ h2).