Module Type RMAPS.
Declare Module AV:ADR_VAL.
Parameter rmap : Type.
Inductive preds : Type :=
SomeP : forall A : TypeTree,
(forall ts: list Type, dependent_type_functor_rec ts A (pred rmap)) -> preds.
Definition NoneP := SomeP (ConstType unit) (fun _ => tt).
Inductive resource : Type :=
| NO: forall sh: Share.t, ~(readable_share sh) -> resource
| YES: forall sh: Share.t, readable_share sh -> kind -> preds -> resource
| PURE: kind -> preds -> resource.
Definition res_option (r:resource) : option (rshare * kind) :=
match r with
| NO _ _ => None
| YES sh rsh k _ => Some (readable_part rsh,k)
| PURE k _ => None
end.
Inductive res_join : resource -> resource -> resource -> Prop :=
| res_join_NO1 : forall sh1 nsh1 sh2 nsh2 sh3 nsh3
(RJ: join sh1 sh2 sh3),
res_join (NO sh1 nsh1) (NO sh2 nsh2) (NO sh3 nsh3)
| res_join_NO2 : forall sh1 rsh1 sh2 nsh2 sh3 rsh3 k p
(RJ: join sh1 sh2 sh3),
res_join (YES sh1 rsh1 k p) (NO sh2 nsh2) (YES sh3 rsh3 k p)
| res_join_NO3 : forall sh1 nsh1 sh2 rsh2 sh3 rsh3 k p
(RJ: join sh1 sh2 sh3),
res_join (NO sh1 nsh1) (YES sh2 rsh2 k p) (YES sh3 rsh3 k p)
| res_join_YES : forall sh1 rsh1 sh2 rsh2 sh3 rsh3 k p
(RJ: join sh1 sh2 sh3),
res_join (YES sh1 rsh1 k p) (YES sh2 rsh2 k p) (YES sh3 rsh3 k p)
| res_join_PURE : forall k p, res_join (PURE k p) (PURE k p) (PURE k p).
Instance Join_resource: Join resource := res_join.
Definition preds_fmap (f g: pred rmap -> pred rmap) (x:preds) : preds :=
match x with SomeP A Q => SomeP A (fmap (fpi _) f g Q)
end.
Definition resource_fmap (f g:pred rmap -> pred rmap) (x:resource) : resource :=
match x with
| NO sh nsh => NO sh nsh
| YES sh rsh k p => YES sh rsh k (preds_fmap f g p)
| PURE k p => PURE k (preds_fmap f g p)
end.
Definition ghost : Type := list (option ({g: Ghost & {a: @G g | ghost.valid a}} * preds)%type).
Instance preds_join : Join _ := Join_equiv preds.
Inductive ghost_elem_join : Join {g: Ghost & {a: @G g | ghost.valid a}} :=
| elem_join_I g a b c va vb vc: join a b c ->
ghost_elem_join (existT _ g (exist _ a va)) (existT _ g (exist _ b vb))
(existT _ g (exist _ c vc)).
Existing Instance ghost_elem_join.
Inductive ghost_join : Join ghost :=
| ghost_join_nil_l m: ghost_join nil m m
| ghost_join_nil_r m: ghost_join m nil m
| ghost_join_cons a1 a2 m1 m2 a3 m3: join a1 a2 a3 -> ghost_join m1 m2 m3 ->
ghost_join (a1 :: m1) (a2 :: m2) (a3 :: m3).
Existing Instance ghost_join.
Definition ghost_fmap (f g:pred rmap -> pred rmap)(x:ghost) : ghost :=
map (option_map (fun '(a, b) => (a, preds_fmap f g b))) x.
Definition rmap' := ((address -> resource) * ghost)%type.
Definition rmap_fmap (f g: pred rmap -> pred rmap) (x:rmap') : rmap' :=
(resource_fmap f g oo fst x, ghost_fmap f g (snd x)).
Parameter squash : (nat * rmap') -> rmap.
Parameter unsquash : rmap -> (nat * rmap').
Definition resource_at (phi:rmap) : address -> resource := fst (snd (unsquash phi)).
Infix "@" := resource_at (at level 50, no associativity).
Definition ghost_of (phi:rmap) : ghost := snd (snd (unsquash phi)).
Instance Join_nat_rmap': Join (nat * rmap') := Join_prod _ (Join_equiv nat) _ _.
Definition rmap_unage (k:rmap) : rmap :=
match unsquash k with
| (n,x) => squash (S n, x)
end.
Program Definition approx (n:nat) (p: pred rmap) : pred rmap :=
fun w => level w < n /\ p w.
Next Obligation.
destruct H0.
split.
apply age_level in H. omega.
apply pred_hereditary with a; auto.
Qed.

Axiom squash_unsquash : forall phi, squash (unsquash phi) = phi.
Axiom unsquash_squash : forall n rm, unsquash (squash (n,rm)) = (n,rmap_fmap (approx n) (approx n) rm).
Axiom ghost_of_core : forall phi, ghost_of (core phi) = core (ghost_of phi).