Module Type RMAPS.
Declare Module AV:ADR_VAL.
Parameter rmap : Type.
Inductive preds : Type :=
SomeP : forall A : list Type, (listprod A -> pred rmap) -> preds.
Definition NoneP := SomeP ((Void:Type)::nil) (fun _ => FF).
Definition hair := preds.
Inductive resource : Type :=
| NO
| YES: pshare -> kind -> preds -> resource
| PURE: kind -> preds -> resource.
Definition res_option (r:resource) :=
match r with
| NO => None
| YES sh k _ => Some (sh,k)
| PURE k _ => None
end.
Inductive res_join : resource -> resource -> resource -> Prop :=
| res_join_NO1 : res_join NO NO NO
| res_join_NO2 : forall sh k p, res_join (YES sh k p) NO (YES sh k p)
| res_join_NO3 : forall sh k p, res_join NO (YES sh k p) (YES sh k p)
| res_join_YES : forall (sh1 sh2 sh3:pshare) k p,
join sh1 sh2 sh3 ->
res_join (YES sh1 k p) (YES sh2 k p) (YES sh3 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:pred rmap -> pred rmap) (x:preds) : preds :=
match x with SomeP A Q => SomeP A (f oo Q)
end.
Definition resource_fmap (f:pred rmap -> pred rmap) (x:resource) : resource :=
match x with
| NO => NO
| YES sh k p => YES sh k (preds_fmap f p)
| PURE k p => PURE k (preds_fmap f p)
end.
Definition valid (m: address -> resource) : Prop :=
AV.valid  (res_option oo m).
Definition rmap' := sig valid.
Definition rmap_fmap (f: pred rmap -> pred rmap) (x:rmap') : rmap' :=
match x with exist m H => exist (fun m => valid m) (resource_fmap f oo m) (valid_res_map f m H) end.
Parameter squash : (nat * rmap') -> rmap.
Parameter unsquash : rmap -> (nat * rmap').
Definition resource_at (phi:rmap) : address -> resource := proj1_sig (snd (unsquash phi)).
Infix "@" := resource_at (at level 50, no associativity).
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) rm).